Need help with a macro!

[mr.durden]

Hi there,

I have a spreadsheet which has been awkwardly formatted by a client with over 50,000 rows. I've tried creating my own macro to automate the work but it just won't seem to work (i'm probably missing something obvious).

At the moment the data looks like this:

[TABLE="width: 377"]
<colgroup><col><col><col></colgroup><tbody>[TR]
[TD]00229268[/TD]
[TD]Example 1[/TD]
[TD]6089+8038[/TD]
[/TR]
[TR]
[TD]00157910[/TD]
[TD]Example 2[/TD]
[TD]6090+6274[/TD]
[/TR]
</tbody>[/TABLE]

I want it to look like this:

[TABLE="width: 377"]
<tbody>[TR]
[TD]00229268[/TD]
[TD]Example 1[/TD]
[TD]6089[/TD]
[/TR]
[TR]
[TD]00229268[/TD]
[TD]Example 1[/TD]
[TD]8038[/TD]
[/TR]
</tbody>[/TABLE]
[TABLE="width: 377"]
<tbody>[TR]
[TD]00157910[/TD]
[TD]Example 2[/TD]
[TD]6090[/TD]
[/TR]
[TR]
[TD]00157910[/TD]
[TD]Example 2[/TD]
[TD]6274[/TD]
[/TR]
</tbody>[/TABLE]


At the moment I am copying and inserting endlessly. Please help me!

Thanks

 

[tigeravatar]

Maybe...

Sub tgr()
    
    Dim arrData() As Variant
    Dim varNum As Variant
    Dim DataIndex As Long
    Dim rIndex As Long
    
    ReDim arrData(1 To Rows.Count, 1 To 3)
    
    For rIndex = 1 To Cells(Rows.Count, "A").End(xlUp).Row
        For Each varNum In Split(Cells(rIndex, "C").Value, "+")
            DataIndex = DataIndex + 1
            arrData(DataIndex, 1) = Cells(rIndex, "A").Value
            arrData(DataIndex, 2) = Cells(rIndex, "B").Value
            arrData(DataIndex, 3) = varNum
        Next varNum
    Next rIndex
    
    If DataIndex > 0 Then Range("A1").Resize(DataIndex, UBound(arrData, 2)).Value = arrData
    
    Erase arrData
    
End Sub

 

[mr.durden]

Hi Tiger,

Thanks very much for the quick reply. Really appreciate it.

I'm sorry but I probably should have been clearer when I described the document, as I really know very little about macros.

The cells that I've outlined correspond to columns E, F and G (G being the last cell with the data that needs splitting). I need all the columns before this (A-D) to be copied into the new row too. Also, not all of the G cells have a plus in them and are fine (I think the macro will omit those ones anyway?) and some have a plus at the end like 89237+237643+. I was just going to remove these with a find/replace at the end so long as they don't affect the macro.

I'd really appreciate your advice again here.

Many thanks!

 

[tigeravatar]

The cells that I've outlined correspond to columns E, F and G (G being the last cell with the data that needs splitting). I need all the columns before this (A-D) to be copied into the new row too.

Macro has been updated to accomodate

Also, not all of the G cells have a plus in them and are fine (I think the macro will omit those ones anyway?) and some have a plus at the end like 89237+237643+. I was just going to remove these with a find/replace at the end so long as they don't affect the macro.

It wouldn't affect the macro if there is no + in the cell
Macro has been updated to accomodate if the cell ends with a +


Here is the update code:

Sub tgr()
    
    Dim arrData() As Variant
    Dim varNum As Variant
    Dim DataIndex As Long
    Dim rIndex As Long, cIndex As Long
    
    ReDim arrData(1 To Rows.Count, 1 To 7)
    
    For rIndex = 1 To Range("A:G").Find("*", Range("A1"), SearchDirection:=xlPrevious).Row
        For Each varNum In Split(Cells(rIndex, UBound(arrData, 2)).Value, "+")
            If Len(varNum) > 0 Then
                DataIndex = DataIndex + 1
                For cIndex = 1 To UBound(arrData, 2) - 1
                    arrData(DataIndex, cIndex) = Cells(rIndex, cIndex).Value
                Next cIndex
                arrData(DataIndex, UBound(arrData, 2)) = varNum
            End If
        Next varNum
    Next rIndex
    
    If DataIndex > 0 Then Range("A1").Resize(DataIndex, UBound(arrData, 2)).Value = arrData
    
    Erase arrData
    
End Sub

 

[mr.durden]

Hi Tiger,

Thanks for this, worked a treat.

Sorry to keep questioning but the client has just told me that if the G column cell ends in a plus then that plus needs to be moved over into the H column for future reference.

How would I amend the code to do this?

Also, are there any resources you'd recommend for learning to make these macros? I would like to become more competent with them myself.

Appreciate the help!

 

[tigeravatar]

So if the cell in column G is: 89237+237643+
You need 89237 in its own cell, 237643 in its own cell in the next row, and the + in its own cell in column H. Should the + go in each row for that item, or just the last row, or just the first row, or elsewhere?

As for learning, I am all self-taught. I can only recommend diving into the help files (F1) and using google to find what you're looking for. The macro recorder is also an excellent starting place to learn what code looks like and get basic syntax. After that, its modifying what you record, and then searching for answers you can't seem to find in the help files and adjusting what you find online to meet your needs. The more practice, the better.

 

[mr.durden]

Hi Tiger,

I managed to sort this using a right formula to grab the pluses before running your macro.

Do have one last issue though which if you could help me with would put everything perfectly in order. I posted the question elsewhere on this forum as I thought it would count as a different topic. Sure you'll have some idea how to do this:

I have a spreadsheet of about 50,000 rows and up to column I contains data. Occasionally in column G there is a range e.g. 8364-8370 (the rest is single numbers which don't need changing).

When a range like this appears however I need all of the individual range numbers to scale one by one onto on their own row with the associated column data copied too...

The size of these ranges varies on each occasion.

 

[tigeravatar]

This is very similar. I made a few adjustments in an attempt to make it easier for you edit:

Sub tgr()
    
    Const strSplitCol As String = "G"
    
    Dim arrData() As Variant
    Dim varNum As Variant
    Dim DataIndex As Long
    Dim rIndex As Long, cIndex As Long
    
    ReDim arrData(1 To Rows.Count, 1 To Columns("I").Column)
    
    For rIndex = 1 To Range("A:A").Resize(, UBound(arrData, 2)).Find("*", Range("A1"), SearchDirection:=xlPrevious).Row
        For Each varNum In Split(Cells(rIndex, strSplitCol).Value, "-")
            If Len(varNum) > 0 Then
                DataIndex = DataIndex + 1
                For cIndex = 1 To UBound(arrData, 2)
                    If cIndex <> Columns(strSplitCol).Column Then
                        arrData(DataIndex, cIndex) = Cells(rIndex, cIndex).Value
                    End If
                Next cIndex
                arrData(DataIndex, Columns(strSplitCol).Column) = varNum
            End If
        Next varNum
    Next rIndex
    
    If DataIndex > 0 Then Range("A1").Resize(DataIndex, UBound(arrData, 2)).Value = arrData
    
    Erase arrData
    
End Sub

 

[mr.durden]

Hi,

Thanks for the alterations.

The macro worked similar to before but what I meant was slightly different. I was hoping to fill the range of numbers, so that for example 3096-4000 is split into:

3096
3097
3098
3099
4000

with the same original data in the rows either side copied across this range. There might be some terminology for this that I don't know. Does this make sense?

Thank yoU!

 

[tigeravatar]

Untested, but give this a try:

Sub tgr()
    
    Const strSplitCol As String = "G"
    
    Dim arrData() As Variant
    Dim varNum As Variant
    Dim DataIndex As Long
    Dim rIndex As Long, cIndex As Long
    
    ReDim arrData(1 To Rows.Count, 1 To Columns("I").Column)
    
    For rIndex = 1 To Range("A:A").Resize(, UBound(arrData, 2)).Find("*", Range("A1"), SearchDirection:=xlPrevious).Row
        For varNum = Split(Cells(rIndex, strSplitCol).Value, "-")(0) To Split(Cells(rIndex, strSplitCol).Value, "-")(1)
            DataIndex = DataIndex + 1
            For cIndex = 1 To UBound(arrData, 2)
                If cIndex <> Columns(strSplitCol).Column Then
                    arrData(DataIndex, cIndex) = Cells(rIndex, cIndex).Value
                End If
            Next cIndex
            arrData(DataIndex, Columns(strSplitCol).Column) = CDbl(varNum)
        Next varNum
    Next rIndex
    
    If DataIndex > 0 Then Range("A1").Resize(DataIndex, UBound(arrData, 2)).Value = arrData
    
    Erase arrData
    
End Sub