macro is searching A column for cells with specific text and writes another text to another cell in all next rows until it finds next A cell with specific text and does the same. ex
A1 contains text "(1)" then write text "a" in C2,C3,C4.... until it finds
A10 contains text "(16)" then write text "b" in C11,C12,..... until it finds
A24 contains text "(19)" th[enter image description here][1]en write "c" in C25,C26 ...
All the other cells between cells that contain text contain numbers
you can go like this:
Option Explicit
Sub main()
Dim iArea As Long
Dim rng As Range
Dim texts As Variant
texts = Array("a", "b", "c") '<--| array containing your "texts", be sure therer are at least as much elements as cells with "('number')" in column A
With Worksheets("mySheet") '<--| change "mySheet" to your actual worksheet with data name
With .Range("A1", .Cells(.Rows.count, "A").End(xlUp)) '<--| reference its column "A" cells from row 1 down to last not empty one
With .Resize(.Rows.count + 1)
.Cells(.Rows.count).Value = "number : (0)" '<--| add "dummy" "specific" text. it'll be removed by the end of the macro
.AutoFilter field:=1, Criteria1:="=*(*)*" '<--| filter it with "*(*)*" string
If Application.WorksheetFunction.Subtotal(103, .Cells) > 1 Then '<--| if any filtered cell found
Set rng = .SpecialCells(xlCellTypeVisible) '<--| set the range corresponding filtered cells
.Parent.AutoFilterMode = False '<--| remove autofilter and show all rows back
With rng '<--| reference filtered cells
For iArea = 1 To .Areas.count - 1 '<--| loop through them (each filtered cell is an 'Area') excluding last ("dummy") one
.Parent.Range(.Areas(iArea).Cells(2, 3), .Areas(iArea + 1).Cells(1, 3).Offset(-1)).Value = texts(iArea - 1) 'fill column "C" (third from referenced cell in column A) with 'texts' element corresponding to current area
Next iArea
End With
End If
.Cells(.Rows.count).ClearContents '<--| clear add "dummy" "specific" text
End With
End With
End With
End Sub
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.