help with Macro

J

jmkerzic

New Member
Joined
Jul 5, 2019
Messages
31
I am getting this error with this Macro below. I added to it but then I removed what I added but I guess i deleted something that I should not of.
1624471580266.png

VBA Code: 
Sub Macro1()
'
' Macro1 Macro
'
  Dim numOfRows As Integer
    Dim numOfCols As Integer
   
    ' Get the number of rows in the spreadsheet
    numOfRows = Worksheets(1).UsedRange.Rows.Count
    numOfCols = Worksheets(1).UsedRange.Columns.Count
   
    ' Loop through each row and convert UPCs to 12 digit UPCs
    Dim rowIndex As Integer
    Dim colIndex As Integer
    Dim currentCell As String
   
    ' Loop through each row
    For rowIndex = 2 To numOfRows
        ' Loop through each column
        For colIndex = 1 To numOfCols
            ' Reset the currentUPC variable
            currentCell = ""
           
            ' If the header for the current column is CreditDebitNum, InvoiceNum, PONum then convert the cell to text
            ' If the header for the current column starts with UPC and the current cell contains a value check to see if it needs to be fixed
            If (Cells(1, colIndex).Value = "CreditDebitNum" Or Cells(1, colIndex).Value = "InvoiceNum" Or Cells(1, colIndex).Value = "PONum") And Trim(Cells(rowIndex, colIndex).Value) <> "" Then
                ' Copy the current cell content to the clipboard
                currentCell = Trim(Cells(rowIndex, colIndex).Value)
               
                ' Change the format of the current cell to Text
                Cells(rowIndex, colIndex).NumberFormat = "@"
                   
                ' Update the current cell with the fixed UPC
                Cells(rowIndex, colIndex).Value = currentCell
            ElseIf Left(Cells(1, colIndex).Value, 3) = "UPC" And Trim(Cells(rowIndex, colIndex).Value) <> "" Then
                ' If the length of the current cell is greater than 10 then this should be a 12 digit UPC, else leave it alone
                If Len(Trim(Cells(rowIndex, colIndex).Value)) > 10 Then
                    ' Update the current cell to a 12 digit UPC and save it to a temporary variable
                    currentCell = Right("000000000000" & Trim(Cells(rowIndex, colIndex).Value), 12)
                   
                    ' Change the format of the current cell to Text
                    Cells(rowIndex, colIndex).NumberFormat = "@"
                   
                    ' Update the current cell with the fixed UPC
                    Cells(rowIndex, colIndex).Value = currentCell
                End If
               '
    Cells.Select
        Selection.FormatConditions.add Type:=xlExpression, Formula1:= _
        "=RIGHT($C1,1)=""B"""
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent1
        .Color = 65280
        .TintAndShade = 0
    End With
    Cells.Select
        Selection.FormatConditions.add Type:=xlExpression, Formula1:= _
        "=LEFT($C1,1)=""R"""
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent1
        .Color = 13882323
        .TintAndShade = 0
         End With
    Selection.FormatConditions.add Type:=xlExpression, Formula1:= _
        "=LEFT($C1,1)=""V"""
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent1
        .Color = 9419919
        .TintAndShade = 0
         End With
    Selection.FormatConditions(1).StopIfTrue = False
    Cells.Select
        Selection.FormatConditions.add Type:=xlExpression, Formula1:= _
        "=LEFT($C1,1)=""T"""
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent1
        .Color = 13408767
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = False
    Application.CutCopyMode = False
    Application.CutCopyMode = False
    Selection.FormatConditions(1).StopIfTrue = False
    Application.CutCopyMode = False
    Application.CutCopyMode = False
    Selection.FormatConditions.add Type:=xlExpression, Formula1:= _
        "=COUNTIF(1:1,""*1m*"")"
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 65535
        .TintAndShade = 0
    End With
        Selection.FormatConditions(1).StopIfTrue = False
    Application.CutCopyMode = False
    Application.CutCopyMode = False
    Selection.FormatConditions(1).StopIfTrue = False
    Application.CutCopyMode = False
    Application.CutCopyMode = False
    Selection.FormatConditions.add Type:=xlExpression, Formula1:= _
        "=COUNTIF(1:1,""*0m*"")"
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 65535
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = False
Cells.Select
    Selection.FormatConditions.add Type:=xlExpression, Formula1:= _
        "=RIGHT($C1,1)=""c"""
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent1
        .Color = 16776960
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = False
        Cells.Select
        Selection.FormatConditions.add Type:=xlExpression, Formula1:= _
        "=AND(LEFT($C1,1)=""R"",RIGHT($C1,1)=""B"")"
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent2
        .TintAndShade = 0.399945066682943
    End With
          Selection.FormatConditions(1).StopIfTrue = False
        Cells.Select
    Range("A352").Activate
    Selection.FormatConditions.add Type:=xlExpression, Formula1:= _
        "=AND(LEFT($C1,1)=""V"",RIGHT($C1,1)=""B"")"
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent2
        .Color = 16751052
        End With

       
   
   '
 Dim dateToUse As String
    Dim dateOverride As String
    Dim worksheetName As String
  
    Select Case Weekday(Now)
        ' Sunday = 1, Monday = 2, Tuesday = 3, Wednesday = 4, Thursday = 5, Friday = 6, Saturday = 7
        Case 1
            ' Get Friday's date(subtract 2 days from today)
            dateToUse = Format(DateAdd("d", -2, CDate(Now)), "mm-dd-yyyy")
        Case 2
            ' Get Friday's date(subtract 3 days from today)
            dateToUse = Format(DateAdd("d", -3, CDate(Now)), "mm-dd-yyyy")
        Case 3, 4, 5, 6, 7
            ' Get Previous days date
            dateToUse = Format(DateAdd("d", -1, CDate(Now)), "mm-dd-yyyy")
    End Select
  
    dateOverride = ""
    If dateOverride = "" Then
        worksheetName = dateToUse
    Else
        worksheetName = dateOverride
    End If '
   
    ' Autofit all the columns in the worksheet
    Range(Columns(1), Columns(numOfCols)).AutoFit
        Sheets.add After:=ActiveSheet
    Sheets("All Vendors 06-22-2021").Select
    Cells.Select
    Selection.Copy
    Sheets("Sheet1").Select
    ActiveSheet.Paste
  Columns("B:B").Select
    Selection.TextToColumns Destination:=Range("B1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(1, 1), TrailingMinusNumbers:=True
    Range("A3").Select
    Columns("E:F").Select
    Range("F1").Activate
    Selection.NumberFormat = "0.00"
    Range("F4").Select
    Columns("g:h").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Windows("PERSONAL.XLSB").Activate
    Range("H2:I2").Select
    Selection.Copy
    Windows("All Vendors 06-22-2021").Activate
    Range("G2").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Selection.AutoFill Destination:=Range("G2:H4000")
    Range("G2:H4000").Select
    Columns("G:G").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Columns("H:H").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlToLeft
    Cells.Select
    ActiveWorkbook.Worksheets("sheet1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("sheet1").Sort.SortFields.add Key:=Range("c2:c4000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortTextAsNumbers
    With ActiveWorkbook.Worksheets("sheet1").Sort
        .SetRange Range("A1:AQ4000")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    Range("H2").Select
    Selection.ClearContents
    Range("H2").Select
    ActiveCell.FormulaR1C1 = _
        "=RC[-1]&IF(OR(RIGHT(RC[-5])={""B"",""C""}),"" BLM"","""")&IF(LEFT(RC[-5])=""R"","" Rack"","""")&IF(LEFT(RC[-5],3)=""TRT"","" TRT"","""")"
    Range("H2").Select
    Selection.Copy
    Application.CutCopyMode = False
    Selection.AutoFill Destination:=Range("H2:H5000")
    Range("H2:H5000").Select
    Selection.Copy
    Range("G2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Columns("H:H").Select
    Selection.ClearContents
    Range("H7").Select
    End With

End Sub
 

Excel Facts

How to find 2nd largest value in a column?
MAX finds the largest value. =LARGE(A:A,2) will find the second largest. =SMALL(A:A,3) will find the third smallest
Sort by date Sort by votes
You are missing an end if here
VBA Code: 
            If (Cells(1, colIndex).Value = "CreditDebitNum" Or Cells(1, colIndex).Value = "InvoiceNum" Or Cells(1, colIndex).Value = "PONum") And Trim(Cells(rowIndex, colIndex).Value) <> "" Then
                ' Copy the current cell content to the clipboard
                currentCell = Trim(Cells(rowIndex, colIndex).Value)
               
                ' Change the format of the current cell to Text
                Cells(rowIndex, colIndex).NumberFormat = "@"
                   
                ' Update the current cell with the fixed UPC
                Cells(rowIndex, colIndex).Value = currentCell
            ElseIf Left(Cells(1, colIndex).Value, 3) = "UPC" And Trim(Cells(rowIndex, colIndex).Value) <> "" Then
                ' If the length of the current cell is greater than 10 then this should be a 12 digit UPC, else leave it alone
                If Len(Trim(Cells(rowIndex, colIndex).Value)) > 10 Then
                    ' Update the current cell to a 12 digit UPC and save it to a temporary variable
                    currentCell = Right("000000000000" & Trim(Cells(rowIndex, colIndex).Value), 12)
                   
                    ' Change the format of the current cell to Text
                    Cells(rowIndex, colIndex).NumberFormat = "@"
                   
                    ' Update the current cell with the fixed UPC
                    Cells(rowIndex, colIndex).Value = currentCell
                End If
        End If
But you are also missing the end of both loops
 
Upvote 0
Solution
Thanks. Now I get for without next error. I added the End IF where you marked it.

Sub Macro1()
'
' Macro1 Macro
'
Dim numOfRows As Integer
Dim numOfCols As Integer

' Get the number of rows in the spreadsheet
numOfRows = Worksheets(1).UsedRange.Rows.Count
numOfCols = Worksheets(1).UsedRange.Columns.Count

' Loop through each row and convert UPCs to 12 digit UPCs
Dim rowIndex As Integer
Dim colIndex As Integer
Dim currentCell As String

' Loop through each row
For rowIndex = 2 To numOfRows
' Loop through each column
For colIndex = 1 To numOfCols
' Reset the currentUPC variable
currentCell = ""

' If the header for the current column is CreditDebitNum, InvoiceNum, PONum then convert the cell to text
' If the header for the current column starts with UPC and the current cell contains a value check to see if it needs to be fixed
If (Cells(1, colIndex).Value = "CreditDebitNum" Or Cells(1, colIndex).Value = "InvoiceNum" Or Cells(1, colIndex).Value = "PONum") And Trim(Cells(rowIndex, colIndex).Value) <> "" Then
' Copy the current cell content to the clipboard
currentCell = Trim(Cells(rowIndex, colIndex).Value)

' Change the format of the current cell to Text
Cells(rowIndex, colIndex).NumberFormat = "@"

' Update the current cell with the fixed UPC
Cells(rowIndex, colIndex).Value = currentCell
ElseIf Left(Cells(1, colIndex).Value, 3) = "UPC" And Trim(Cells(rowIndex, colIndex).Value) <> "" Then
' If the length of the current cell is greater than 10 then this should be a 12 digit UPC, else leave it alone
If Len(Trim(Cells(rowIndex, colIndex).Value)) > 10 Then
' Update the current cell to a 12 digit UPC and save it to a temporary variable
currentCell = Right("000000000000" & Trim(Cells(rowIndex, colIndex).Value), 12)

' Change the format of the current cell to Text
Cells(rowIndex, colIndex).NumberFormat = "@"

' Update the current cell with the fixed UPC
Cells(rowIndex, colIndex).Value = currentCell
End If
End If
'
Cells.Select
Selection.FormatConditions.add Type:=xlExpression, Formula1:= _
"=RIGHT($C1,1)=""B"""
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent1
.Color = 65280
.TintAndShade = 0
End With
Cells.Select
Selection.FormatConditions.add Type:=xlExpression, Formula1:= _
"=LEFT($C1,1)=""R"""
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent1
.Color = 13882323
.TintAndShade = 0
End With
Selection.FormatConditions.add Type:=xlExpression, Formula1:= _
"=LEFT($C1,1)=""V"""
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent1
.Color = 9419919
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
Cells.Select
Selection.FormatConditions.add Type:=xlExpression, Formula1:= _
"=LEFT($C1,1)=""T"""
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent1
.Color = 13408767
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
Application.CutCopyMode = False
Application.CutCopyMode = False
Selection.FormatConditions(1).StopIfTrue = False
Application.CutCopyMode = False
Application.CutCopyMode = False
Selection.FormatConditions.add Type:=xlExpression, Formula1:= _
"=COUNTIF(1:1,""*1m*"")"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
Application.CutCopyMode = False
Application.CutCopyMode = False
Selection.FormatConditions(1).StopIfTrue = False
Application.CutCopyMode = False
Application.CutCopyMode = False
Selection.FormatConditions.add Type:=xlExpression, Formula1:= _
"=COUNTIF(1:1,""*0m*"")"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
Cells.Select
Selection.FormatConditions.add Type:=xlExpression, Formula1:= _
"=RIGHT($C1,1)=""c"""
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent1
.Color = 16776960
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
Cells.Select
Selection.FormatConditions.add Type:=xlExpression, Formula1:= _
"=AND(LEFT($C1,1)=""R"",RIGHT($C1,1)=""B"")"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent2
.TintAndShade = 0.399945066682943
End With
Selection.FormatConditions(1).StopIfTrue = False
Cells.Select
Range("A352").Activate
Selection.FormatConditions.add Type:=xlExpression, Formula1:= _
"=AND(LEFT($C1,1)=""V"",RIGHT($C1,1)=""B"")"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent2
.Color = 16751052
End With

'
Dim dateToUse As String
Dim dateOverride As String
Dim worksheetName As String

Select Case Weekday(Now)
' Sunday = 1, Monday = 2, Tuesday = 3, Wednesday = 4, Thursday = 5, Friday = 6, Saturday = 7
Case 1
' Get Friday's date(subtract 2 days from today)
dateToUse = Format(DateAdd("d", -2, CDate(Now)), "mm-dd-yyyy")
Case 2
' Get Friday's date(subtract 3 days from today)
dateToUse = Format(DateAdd("d", -3, CDate(Now)), "mm-dd-yyyy")
Case 3, 4, 5, 6, 7
' Get Previous days date
dateToUse = Format(DateAdd("d", -1, CDate(Now)), "mm-dd-yyyy")
End Select

dateOverride = ""
If dateOverride = "" Then
worksheetName = dateToUse
Else
worksheetName = dateOverride
End If '

' Autofit all the columns in the worksheet
Range(Columns(1), Columns(numOfCols)).AutoFit
Sheets.add After:=ActiveSheet
Sheets("All Vendors 06-22-2021").Select
Cells.Select
Selection.Copy
Sheets("Sheet1").Select
ActiveSheet.Paste
Columns("B:B").Select
Selection.TextToColumns Destination:=Range("B1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True
Range("A3").Select
Columns("E:F").Select
Range("F1").Activate
Selection.NumberFormat = "0.00"
Range("F4").Select
Columns("g:h").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Windows("PERSONAL.XLSB").Activate
Range("H2:I2").Select
Selection.Copy
Windows("All Vendors 06-22-2021").Activate
Range("G2").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Selection.AutoFill Destination:=Range("G2:H4000")
Range("G2:H4000").Select
Columns("G:G").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Columns("H:H").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
Cells.Select
ActiveWorkbook.Worksheets("sheet1").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("sheet1").Sort.SortFields.add Key:=Range("c2:c4000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortTextAsNumbers
With ActiveWorkbook.Worksheets("sheet1").Sort
.SetRange Range("A1:AQ4000")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
Range("H2").Select
Selection.ClearContents
Range("H2").Select
ActiveCell.FormulaR1C1 = _
"=RC[-1]&IF(OR(RIGHT(RC[-5])={""B"",""C""}),"" BLM"","""")&IF(LEFT(RC[-5])=""R"","" Rack"","""")&IF(LEFT(RC[-5],3)=""TRT"","" TRT"","""")"
Range("H2").Select
Selection.Copy
Application.CutCopyMode = False
Selection.AutoFill Destination:=Range("H2:H5000")
Range("H2:H5000").Select
Selection.Copy
Range("G2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Columns("H:H").Select
Selection.ClearContents
Range("H7").Select
End With

End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

Q
  • Solved
Using VBA instead of Conditional formatting
2
Replies
12
Views
691
Micron
M
S
  • Question Question
Run VBA code from specific sheet till the end of workbook
Replies
7
Views
244
Alex Blakenburg
A
K
  • Question Question
Variable losing set Range
Replies
8
Views
447
MARK858
MARK858
S
  • Question Question
excel - conditional formatting - only for the last 50 rows of the tabl
Replies
3
Views
307
Vogateer
V
V
  • Question Question
runtime error 1004 in conditional formatting macro recording
Replies
3
Views
286
valmir
V

Forum statistics

Threads
1,223,565
Messages
6,173,092
Members
452,501
Latest member
musallam

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top