CODEWITHSUNDEEP
excelvbaloopsforeach
Jenny Wu
Jenny Wu

Reputation: 40

Excel VBA Macro to Loop Through Cells (Including Blanks) to Last Cell with Data and Replace

I'm new to VBA and need help writing a code... My goal is to loop through each row to go to the last non-blank cell (there's multiple blanks within each row) within that row and replace the ";" with "}". Then continue looping to the bottom of the data set until no more data in row A.

Below is "before" example:

      1          2          3          4          5
 1   {1,$1.00;              3,$2.00;
 2   {1,$1.00;   2,$3.00;              4,$1.00;
 3   {1,$1.00;              3,$2.50;               5,$1.00;

Below is "after" example:

      1          2          3          4          5
 1   {1,$1.00;              3,$2.00}
 2   {1,$1.00;   2,$3.00;              4,$1.00}
 3   {1,$1.00;              3,$2.50;               5,$1.00}

If it helps the pattern of the code is:

Regex: .[0-9]{1,2},[$][0-9]{1,3}[.][0-9][0-9].|[0-9]{1,2},[$][0-9]{1,3}[.][0-9][0-9]

Bonus, if you can also incorporate replace "1;" with "{1;" for every cell in column A (that would be great - I currently just manually do a replace all on column A for "1;" to "{1;".

To give you an idea of how much data it will be: roughly 250 columns, and over 25,000 rows.

Here is the code I have existing, not sure how to loop for next row (also would love to know if I could do this without calling out last row explicitly in case data changes).

Dim LastCell As String
Dim rng As Range
Dim i As Long

For i = 1 To 223127
' Use all cells on the sheet
'Set rng = Sheets("Paste").Cells

'Or use a range on the sheet
Set rng = Sheets("Parse").Range("29:29")

' Find the last cell
LastCell = Last(3, rng)

' Select from A1 till the last cell in Rng
With rng.Parent
    .Select
    .Range(LastCell).Select
   Selection.Replace What:=";", Replacement:="}", Lookat:=xlPart, _
   SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
   ReplaceFormat:=False

Thank you for your help and let me know if I can provide more info.

Upvotes: 1

Views: 69

Answers (1)

VBasic2008
VBasic2008

Reputation: 54853

Replace Strings

Option Explicit

Sub ReplaceStrings()
    
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    Dim ws As Worksheet: Set ws = wb.Worksheets("Parse")
    
    Dim rg As Range: Set rg = ws.UsedRange
    Dim rCount As Long: rCount = rg.Rows.Count
    Dim cCount As Long: cCount = rg.Columns.Count
    
    Dim Data As Variant
    If rCount + cCount = 2 Then
        ReDim Data(1 To 1, 1 To 1): Data(1, 1) = rg.Value
    Else
        Data = rg.Value
    End If
        
    Dim r As Long
    Dim c As Long
    Dim cLen As Long
    Dim cString As String
    
    For r = 1 To rCount
        cString = CStr(Data(r, 1))
        cLen = Len(cString)
        If cLen > 0 Then
            If Left(cString, 1) = "1" Then
                Data(r, 1) = "{1" & Right(cString, cLen - 1)
            End If
        End If
        For c = cCount To 1 Step -1
            cString = CStr(Data(r, c))
            cLen = Len(cString)
            If cLen > 0 Then
                If Right(cString, 1) = ";" Then
                    Data(r, c) = Left(cString, cLen - 1) & "}"
                    Exit For
                End If
            End If
        Next c
    Next r
       
    rg.Value = Data
 
End Sub

Upvotes: 1

Related Questions