Macro to shift data based on "A" column (VBA)

[NCanfield]

I am trying to create a VBA macro that will look at the information in column "A" and determin how many cells it needs to shift the information right for a BOM.

Current data output
[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD]0.1
[/TD]
[TD]PN1235[/TD]
[TD]Bike[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]..2[/TD]
[TD]PN2345[/TD]
[TD]Handle Bar[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]...3[/TD]
[TD]PN3456[/TD]
[TD]Metal Frame[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]....4[/TD]
[TD]pn4567[/TD]
[TD]Stainless Steel[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

Desired data
[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD][/TD]
[TD]0.1[/TD]
[TD]PN1235[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD]..2[/TD]
[TD]PN2345[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]...3[/TD]
[TD]PN3456[/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]....4[/TD]
[TD]4567[/TD]
[/TR]
</tbody>[/TABLE]

My current code is this, but I run into an error when it hits the "rng=" line. I also know the ElseIf statements will be a bit repetative as this can reach 10 levels but this was the easist i could think of.

Sub GapMacro()
    Dim lngRow As Long
    Dim lastRow As Long
    Dim rng As Range

    With ActiveSheet
        lngRow = .Cells(2, 1)
        lastRow = .Cells(65536, 1).End(xlUp).Row
        
        Do
            rng = Range(.Cells(lngRow, 1), .Cells(lngRow, 10))
            If .Cells(lngRow, 1) = "0.1" Then
              rng.Cut rng.Cells(1).Offset(0, 1)
            ElseIf .Cells(lngRow, 1) = "..2" Then
              rng.Cut rng.Cells(1).Offset(0, 2)
            End If

            lngRow = lngRow + 1
        Loop Until lngRow = 1 + lastRow
    End With
End Sub

 

[Fluff]

Hia
you need to set a range

Set rng = Range(.Cells(lngRow, 1), .Cells(lngRow, 10))

Also what are you trying to achieve here?

lngRow = .Cells(2, 1)

 

[Rick Rothstein]

I am pretty sure this macro will do what you are attempting to do...

Sub GapMacro()
  Dim R As Long, Offst As Long
  For R = 1 To Cells(Rows.Count, "A").End(xlUp).Row
    Offst = Mid(Cells(R, "A").Value, InStrRev(Cells(R, "A").Value, ".") + 1) - 1
    If Offst Then Cells(R, "A").Resize(, Offst).Insert xlShiftToRight
  Next
End Sub

 

[NCanfield]

Hia
you need to set a range

Set rng = Range(.Cells(lngRow, 1), .Cells(lngRow, 10))

Also what are you trying to achieve here?

lngRow = .Cells(2, 1)

I was trying to work backwards from a previous bit of code I found and modified a little:

Sub SAPCalMacro()
    Dim lngRow As Long
 
    With ActiveSheet
        lngRow = .Cells(65536, 1).End(xlUp).Row
        .Cells(1).CurrentRegion.Sort key1:=.Cells(1), Header:=xlYes
 
        Do
            If .Cells(lngRow, 1) = .Cells(lngRow - 1, 1) Then
              If .Cells(lngRow - 1, 2) < Date Then
                    If .Cells(lngRow, 2) <> .Cells(lngRow, 4) Then
                    .Cells(lngRow - 1, 2) = .Cells(lngRow, 2)
                    .Cells(lngRow - 1, 3) = .Cells(lngRow, 3)
                    End If
                    .Cells(lngRow - 1, 4) = .Cells(lngRow, 4)
              End If
                    .Rows(lngRow).Delete
            End If
 
            lngRow = lngRow - 1
        Loop Until lngRow = 1
    End With
End Sub

I still get a run-time 1004 error stepping between the "Set rng" line and the first "If" statement.

 

[NCanfield]

I have a type missmatch error stepping between

Offst = Mid(Cells(R, "A").Value, InStrRev(Cells(R, "A").Value, ".") + 1) - 1
    If Offst Then Cells(R, "A").Resize(, Offst).Insert xlShiftToRight

 

[Fluff]

Do you have a header row?

 

[Rick Rothstein]

I have a type missmatch error stepping between

Offst = Mid(Cells(R, "A").Value, InStrRev(Cells(R, "A").Value, ".") + 1) - 1
    If Offst Then Cells(R, "A").Resize(, Offst).Insert xlShiftToRight

Do you by any chance have blank cells mixed in with your dotted numbers that you did not tell us about?

 

[NCanfield]

I had a header row, after I deleted that the your code worked.

For my curiosity and knowledge, any idea why i might be getting the error on my code?