Macro coding for this Thread:
https://excelfox.com/forum/showthrea...ll=1#post15705
Code:Option Explicit Sub AutoNameFill() ' https://excelfox.com/forum/showthread.php/2766-Autofill-Text-if-Criteria-are-met Rem 1 Worksheet info Dim Ws1 As Worksheet: Set Ws1 = ThisWorkbook.Worksheets.Item(1) Dim Lr As Long: Let Lr = Ws1.Range("A" & Ws1.Rows.Count & "").End(xlUp).Row Rem original data in first two columns Dim arrDta() As Variant: Let arrDta() = Ws1.Range("A4:B" & Lr & "").Value2 ' Data range into an array Rem modifying the data in the array Dim Rw As Long ' The data line at any time Dim celVl As String, Nme As String ' the cell value in column 1 at any row , a name Do While Rw < Lr - 4 ' ----- Main outer loop for all data rows Do While InStr(1, celVl, "total", vbBinaryCompare) = 0 And celVl <> "Total" ' This keeps us going until we hit a total Let Rw = Rw + 1: Let celVl = arrDta(Rw, 1) ' next line : cell value in that line If celVl <> "" Then Let Nme = celVl ' this will store our current name if we have one If arrDta(Rw, 2) <> "" And InStr(1, arrDta(Rw, 2), "total", vbBinaryCompare) = 0 Then Let arrDta(Rw, 1) = Nme ' we put the name in if there is data in column 2 and not a total this will also get the name total entry but never mind Loop ' While InStr(1, celVal, "total", vbBinaryCompare) <> 0 ' This keeps us going until we hit a total ' At this point we have reached a total and so will be moving onto the next name section Let celVl = "" ' this clears the last name total entry Loop ' While Rw < (Lr-4) ----- Main outer loop for all data rows Rem Repasting out the modified data Ws1.Range("A4:B" & Lr & "").Value2 = arrDta() End Sub




Reply With Quote
Bookmarks