locked
Extra number? RRS feed

  • Question

  • Hi Everyone,

    I have code that looks at columns to the right every 3 columns. If a value is in the column, it should add 1, 2, 3, and so on to the new column (G:G). What I'm noticing is, if there are less than 13 columns, it will automatically throw 13 in. So, if there are only 12 columns (with data in 3 of the columns), you end up with "1, 2, 3, 13" when it should only be "1, 2, 3."

    My users are wanting to be able to use any amount of columns, without affecting the count. I inherited this code and am also relatively new to VBA, so any help would be greatly appreciated. Thank you.

        Columns("G:G").Select
        TempString = "IF(RC[4]>0,""1,"","""")&IF(RC[7]>0,""2,"","""")&IF(RC[10]>0,""3,"","""")&IF(RC[13]>0,""4,"","""")&IF(RC[16]>0,""5,"","""")&IF(RC[19]>0,""6,"","""")&IF(RC[22]>0,""7,"","""")&IF(RC[25]>0,""8,"","""")&IF(RC[28]>0,""9,"","""")&IF(RC[31]>0,""10,"","""")&IF(RC[34]>0,""11,"","""")&IF(RC[37]>0,""12,"","""")&IF(RC[40]>0,""13,"","""")"
        Selection.FormulaR1C1 = "=IF(LEN(" + TempString + ") > 0, LEFT( " + TempString + ", LEN( " + TempString + " ) - 1 ), " + TempString + " )"
        Columns("G:G").EntireColumn.AutoFit
        Columns("G:G").Formula = Columns("G:G").Value
        Range("G1").Select
        ActiveCell.FormulaR1C1 = "Revised Data"
    Sunday, October 11, 2020 1:20 AM

Answers

  • Try this macro. It should be a lot faster too.

    Sub Test()
        Dim rng As Range
        Dim v() As Variant
        Dim r As Long
        Dim m As Long
        Dim c As Long
        Dim a() As String
        Dim s As String
        Dim i As Long
        m = Range("K:AU").Find(What:="*", SearchOrder:=xlByRows, _
            SearchDirection:=xlPrevious).Row
        Set rng = Range("K1:AU" & m)
        v = rng.Value
        ReDim a(1 To m, 1 To 1)
        a(1, 1) = "Revised Data"
        For r = 2 To m
            i = 0
            s = ""
            For c = 1 To 37 Step 3
                i = i + 1
                If IsNumeric(v(r, c)) Then
                    If v(r, c) > 0 Then
                        s = s & "," & i
                    End If
                End If
            Next c
            If s <> "" Then
                a(r, 1) = Mid(s, 2)
            End If
        Next r
        Range("G1:G" & m).Value = a
        Range("G1").EntireColumn.AutoFit
        Application.ScreenUpdating = True
    End Sub


    Regards, Hans Vogelaar (https://www.eileenslounge.com)

    • Marked as answer by Lanmanna Thursday, October 15, 2020 6:18 AM
    Sunday, October 11, 2020 9:17 PM

All replies

  • I cannot reproduce the problem.

    Could you create a stripped-down copy of the workbook (without sensitive information) and make it available through one of the websites that let you upload and share a file, such as OneDrive, Google Drive, FileDropper or DropBox. Then post a link to the uploaded and shared file here.


    Regards, Hans Vogelaar (https://www.eileenslounge.com)

    Sunday, October 11, 2020 8:48 AM
  • I cannot reproduce the problem.

    Could you create a stripped-down copy of the workbook (without sensitive information) and make it available through one of the websites that let you upload and share a file, such as OneDrive, Google Drive, FileDropper or DropBox. Then post a link to the uploaded and shared file here.


    Regards, Hans Vogelaar (https://www.eileenslounge.com)

    I see the issue. When there are not 13 columns of data (with numbers), it pulls in the next column, even if it's just text. Is there a way to only count it if it's a number? Thank you.

    For example if there's 12 rows of data (with numbers), but it's followed by another 13th row of text, it's counting it as 13.

    Sunday, October 11, 2020 8:15 PM
  • Try this macro. It should be a lot faster too.

    Sub Test()
        Dim rng As Range
        Dim v() As Variant
        Dim r As Long
        Dim m As Long
        Dim c As Long
        Dim a() As String
        Dim s As String
        Dim i As Long
        m = Range("K:AU").Find(What:="*", SearchOrder:=xlByRows, _
            SearchDirection:=xlPrevious).Row
        Set rng = Range("K1:AU" & m)
        v = rng.Value
        ReDim a(1 To m, 1 To 1)
        a(1, 1) = "Revised Data"
        For r = 2 To m
            i = 0
            s = ""
            For c = 1 To 37 Step 3
                i = i + 1
                If IsNumeric(v(r, c)) Then
                    If v(r, c) > 0 Then
                        s = s & "," & i
                    End If
                End If
            Next c
            If s <> "" Then
                a(r, 1) = Mid(s, 2)
            End If
        Next r
        Range("G1:G" & m).Value = a
        Range("G1").EntireColumn.AutoFit
        Application.ScreenUpdating = True
    End Sub


    Regards, Hans Vogelaar (https://www.eileenslounge.com)

    • Marked as answer by Lanmanna Thursday, October 15, 2020 6:18 AM
    Sunday, October 11, 2020 9:17 PM
  • Works great! Thank you!
    Thursday, October 15, 2020 6:19 AM