Home > Enterprise >  VBA macro going rogue. I've no clue what's wrong
VBA macro going rogue. I've no clue what's wrong

Time:11-18

Option Explicit
Sub CompareValues()

    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim ws1EndRow As Long, ws2EndRow As Long, i As Long
    Dim dbAMarca As String, dbASubGrupo As String
    Dim dbAQtddVendas As Range, dbAValorVendas As Range
    Dim dbAQtddEstoque As Range, dbAValorEstoque As Range
    Dim dbBMarca As String, dbBSubGrupo As String
    Dim dbBQtddVendas As Range, dbBValorVendas As Range
    Dim dbBQtddEstoque As Range, dbBValorEstoque As Range

    Set ws1 = Application.Workbooks("1.xlsx").Sheets("Sheet1")
    Set ws2 = Application.Workbooks("2.xls").Sheets("Sheet2")

    i = 4
    ws1EndRow = ws1.UsedRange.Rows(ws1.UsedRange.Rows.Count).Row

    While i < ws1EndRow

        dbASubGrupo = ws1.Cells(i, "D")
        dbAMarca = ws1.Cells(i, "E")
        Set dbAQtddVendas = ws1.Cells(i, "F")
        Set dbAValorVendas = ws1.Cells(i, "G")
        Set dbAQtddEstoque = ws1.Cells(i, "M")
        Set dbAValorEstoque = ws1.Cells(i, "O")

        dbBSubGrupo = ws2.Cells(i - 1, "H")
        dbBMarca = ws2.Cells(i - 1, "J")
        Set dbBQtddVendas = ws2.Cells(i - 1, "Q")
        Set dbBValorVendas = ws2.Cells(i - 1, "R")
        Set dbBQtddEstoque = ws2.Cells(i - 1, "AF")
        Set dbBValorEstoque = ws2.Cells(i - 1, "AI")

        If Not (StrComp(dbAMarca, dbBMarca, 1) And StrComp(dbASubGrupo, dbBSubGrupo, 1)) Then
            ws1.Rows(i).EntireRow.Insert
            ws1.Rows(i).EntireRow.Interior.Color = vbRed
            ws1.Cells(i, "D").Value = ws2.Cells(i - 1, "H").Value
            ws1.Cells(i, "E").Value = ws2.Cells(i - 1, "J").Value
            ws1EndRow = ws1.UsedRange.Rows(ws1.UsedRange.Rows.Count).Row
        Else
            If Not dbAQtddVendas.Value = dbBQtddVendas.Value Then
                dbAQtddVendas.Interior.Color = vbYellow
            End If
            If Not dbAValorVendas.Value = dbBValorVendas.Value Then
                dbAValorVendas.Interior.Color = vbYellow
            End If
            If Not dbAQtddEstoque.Value = dbBQtddEstoque.Value Then
                dbAQtddEstoque.Interior.Color = vbYellow
            End If
            If Not dbAValorEstoque.Value = dbBValorEstoque.Value Then
                dbAValorEstoque.Interior.Color = vbYellow
            End If
        End If
        i = i   1
    Wend

End Sub

The issue seems to be with the string compare, cuz it just creates rows and paints stuff seemingly randomly. I've been debugging stuff for the past 5 hours (I'm new to VBA) and it just doesn't work. The code is supposed to compare string A1 and A2 with string B1 and B2 respectively. If it doesn't match, insert a line, copy B1 and B2 data to A1 and A2 respectively and paint the entire row red, otherwise it'll check if the value inside C1, C2, C3 and C4 is the same as D1, D2, D3 and D4. If yes, do nothing, otherwise paint the C cell with yellow.

CodePudding user response:

StrComp returns a numeric value not a boolean value, this changes how it works with Not operator. If your goal is to check whether the two are exact match you can replace the string compare statement with the following:

If dbAMarca<>dbBMarca and dbASubGrupo<>dbBSubGrupo Then

CodePudding user response:

Ended up fixing it myself. There were many issues with the original code, and now they're all fixed including the one SaintSnowmad pointed out. Here's the final (working) code in case anyone needs something similar in the future.

Option Explicit
Sub CompareValues()

    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim ws1EndRow As Long, ws2EndRow As Long
    Dim i As Long, j As Long, k As Long
    Dim dbAMarca As Range, dbASubGrupo As Range
    Dim dbAQtddVendas As Range, dbAValorVendas As Range
    Dim dbAQtddEstoque As Range, dbAValorEstoque As Range
    Dim dbBMarca As Range, dbBSubGrupo As Range
    Dim dbBQtddVendas As Range, dbBValorVendas As Range
    Dim dbBQtddEstoque As Range, dbBValorEstoque As Range

    Set ws1 = Application.Workbooks("1.xlsx").Sheets("Sheet1")
    Set ws2 = Application.Workbooks("2.xls").Sheets("Sheet2")

    i = 4
    j = 0
    k = 0
    
    ws1EndRow = ws1.UsedRange.Rows(ws1.UsedRange.Rows.Count).Row

    While i < ws1EndRow

        Set dbASubGrupo = ws1.Cells(i, "D")
        Set dbAMarca = ws1.Cells(i, "E")
        Set dbAQtddVendas = ws1.Cells(i, "F")
        Set dbAValorVendas = ws1.Cells(i, "G")
        Set dbAQtddEstoque = ws1.Cells(i, "M")
        Set dbAValorEstoque = ws1.Cells(i, "O")

        Set dbBSubGrupo = ws2.Cells(i - 1 - k, "H")
        Set dbBMarca = ws2.Cells(i - 1 - k, "J")
        Set dbBQtddVendas = ws2.Cells(i - 1 - k, "Q")
        Set dbBValorVendas = ws2.Cells(i - 1 - k, "R")
        Set dbBQtddEstoque = ws2.Cells(i - 1 - k, "AF")
        Set dbBValorEstoque = ws2.Cells(i - 1 - k, "AI")

        If dbAMarca.Value <> dbBMarca.Value Or dbASubGrupo.Value <> dbBSubGrupo.Value Then
            For j = i To i   10
                If ws1.Cells(i, "D").Value = ws2.Cells(j - k, "H").Value And ws1.Cells(i, "E").Value = ws2.Cells(j - k, "J") Then
                    ws1.Rows(i).EntireRow.Insert
                    ws1.Rows(i).EntireRow.ClearFormats
                    ws1.Rows(i).EntireRow.Interior.Color = vbRed
                    ws1.Cells(i, "D").Value = ws2.Cells(j - 1 - k, "H").Value
                    ws1.Cells(i, "E").Value = ws2.Cells(j - 1 - k, "J").Value
                    ws1EndRow = ws1.UsedRange.Rows(ws1.UsedRange.Rows.Count).Row
                    Exit For
                End If
                If j = i   10 Then
                    ws1.Rows(i).EntireRow.Interior.Color = vbCyan
                    k = k   1
                End If
            Next
        Else
            If Not dbAQtddVendas.Value = dbBQtddVendas.Value Then
                dbAQtddVendas.Interior.Color = vbYellow
            End If
            If Not dbAValorVendas.Value = dbBValorVendas.Value Then
                dbAValorVendas.Interior.Color = vbYellow
            End If
            If Not dbAQtddEstoque.Value = dbBQtddEstoque.Value Then
                dbAQtddEstoque.Interior.Color = vbYellow
            End If
            If Not dbAValorEstoque.Value = dbBValorEstoque.Value Then
                dbAValorEstoque.Interior.Color = vbYellow
            End If
        End If
        i = i   1
    Wend

End Sub
  • Related