For Next Loop starting with numeric cell

Amapola188 · Jun 12th 2018

Good Afternoon,

I'm trying to write a macro that on the surface seems pretty straight forward but the solution eludes me. I'm trying to turn a report into a table. The sheet will contain blocks of data with some information in the header which I'm trying to add to the individual rows so we can work with the data as a table.

The report would look something like this (but messier, with heaps of blank rows in between, and repeated blocks of this data):
123NZ
Office: XYZ
Cost Centre: 77777

Product Number - Blank column - Description
123456 - Blank column - 123455 something
0987766 - blank column - 0987766 another thing

What I'm trying is do is to place the office and cost centre information in between Product Number and Description. I'm utilising the Blank column and adding another one. (that bit works ...). I also have variables for the office and cost centre but I can't manage to write the code that finds the rows where to insert the data.

Ultimately, I need two loops because it's blocks of data but before I run, I just want to be able to walk to get the code to manage the first block of data. This means I need a loop that inserts Office and Cost Centre in columns B and C in each row that starts with a cell that contains a number only. I'm trying to use ISNUMERIC but nothing I've tried to for has inserted any data anywhere.

I need the code to find the point where to start, i.e. the first row with only numbers in column A.
I also need the code to stop whent the numbers end. The following row would either be a blank row or start the next block.

This is the code so far:

Code

Public Sub AgedStock()


'Insert Column
Range("B1").EntireColumn.Insert
Range("A1").Select


'Add Headers for Plant, Profit Centre and Storage Location




'For Each
'Find 423S
Dim rngBlock As Range
ActiveSheet.Range("A:A").Find("423S", LookIn:=xlValues).Select
Set rngBlock = ActiveCell


'Memorise Plant, Profit Centre and Storage Location
Dim strPlant As String
Dim strPC As String
Dim strSL As String


strPlant = ActiveCell.Offset(4, 5).Value
strPC = ActiveCell.Offset(5, 5).Value
strSL = ActiveCell.Offset(6, 5).Value


'Find 1st row with Article Number


Dim LastRow As Integer
LastRow = rngBlock.Offset(13, 0).End(xlDown).Count


For Row = rngBlock.Offset(13, 0) To LastRow
    If IsNumeric(Cells(Row, 1)) Then
        Row = Row + 1
        Rows(Row).Select
        ActiveCell.Offset(0, 1).Value = strPlant 'Column B - Enter Plant
        ActiveCell.Offset(0, 2).Value = strPC 'Column C - Enter Profit Centre
        ActiveCell.Offset(0, 3).Value = strSL 'Column D - Enter Storage Location
        rngBlock.Select
    End If
Next Row


End Sub

Display More

I haven't found a lot of information on ISNUMERIC and at this point, it's likely that both the code for the loop and the IF function has issues.

Any help will be much appreciated.

Thanks,
Christine
Auckland

chavezm3 · Jun 12th 2018

I'm having a little trouble understanding how your sheet is laid out, can you attach an example spreadsheet

Amapola188 · Jun 12th 2018

Hi Chavezm3, I have uploaded a modified sheet. I've left 3 blocks of data, the real sheet goes down to about line 8000. - I have to profess that I don't have huge familiarity with the report, as I'm doing this for a colleague.

Thanks, Christine

Amapola188 · Jun 13th 2018

Yes, the other data would remain. The end result would be a table with Product Number, Plant, Profit Centre, Storage Location, Description, etc. - all the headers would be removed (my colleague is happy to just sort the data and delete those line once the info in the header has been transferred).
I have attached an example of what the end result would look like.
Thanks, Christine

chavezm3 · Jun 13th 2018

I think this does the trick

[VBA]Option Compare Text

Sub Report_to_Table()

Dim Cell As Object, Cellb As Object
Dim Ws_1 As Worksheet, Ws_2 As Worksheet
Dim LastRwReport As Long, RwStart As Long, RwEnd As Long, NextRwTable As Long
Dim strPlant As String, strPC As String, strStgLoc As String

Set Ws_1 = Worksheets("stock ageing")
Set Ws_2 = Worksheets.Add(After:=Worksheets(Worksheets.Count)) 'create new sheet to build table on

'find bottom of report output
LastRwReport = Ws_1.Cells(Rows.Count, "A").End(xlUp).Row

'bulid new table header
Ws_1.Range("G9:AF9").Copy Ws_2.Range("H1")
Ws_1.Range("G11:AF11").Copy Ws_2.Range("H2")
Ws_2.Range("A2").Value = "Article No"
Ws_2.Range("B2").Value = "Plant"
Ws_2.Range("C2").Value = "Profit Centre"
Ws_2.Range("D2").Value = "Storage Location"
Ws_2.Range("E2").Value = "Description"

For Each Cell In Ws_1.Range("A1:A" & LastRwReport)
If Cell.Value = "423S" Then
strPlant = Cell.Offset(4, 4).Value
strPC = Cell.Offset(5, 4).Value
strStgLoc = Cell.Offset(6, 4).Value
Debug.Print strPlant, strPC, strStgLoc

If Cell.Offset(13, 0).Value <> "" Then 'checks if at least 2 article numbers
RwStart = Cell.Offset(12, 0).Row
RwEnd = Cell.Offset(12, 0).End(xlDown).Row
For Each Cellb In Ws_1.Range(Ws_1.Cells(RwStart, 1), Ws_1.Cells(RwEnd, 1))
NextRwTable = Ws_2.Cells(Rows.Count, "A").End(xlUp).Row + 1
Ws_1.Cells(Cellb.Row, 1).Copy Ws_2.Cells(NextRwTable, 1)
Ws_1.Range(Ws_1.Cells(Cellb.Row, 4), Ws_1.Cells(Cellb.Row, 32)).Copy Ws_2.Cells(NextRwTable, 5)
Ws_2.Cells(NextRwTable, 2).Value = strPlant
Ws_2.Cells(NextRwTable, 3).Value = strPC
Ws_2.Cells(NextRwTable, 4).Value = strStgLoc
Next Cellb
Else ' if only one article then just copies the one
NextRwTable = Ws_2.Cells(Rows.Count, "A").End(xlUp).Row + 1
Ws_1.Cells(Cell.Offset(12, 0).Row, 1).Copy Ws_2.Cells(NextRwTable, 1)
Ws_1.Range(Ws_1.Cells(Cell.Offset(12, 0), 3), Ws_1.Cells(Cell.Offset(12, 0), 32)).Copy Ws_2.Cells(NextRwTable, 5)
Ws_2.Cells(NextRwTable, 2).Value = strPlant
Ws_2.Cells(NextRwTable, 3).Value = strPC
Ws_2.Cells(NextRwTable, 4).Value = strStgLoc
End If
End If
Next Cell

End Sub[/VBA]

This assumes that article numbers will always appear 12 rows below the "423S", which I assume is the report name. I also wasn't sure if you could ever encounter a data block that only listed one item. I didn't copy the report header over because I wasn't sure if it was important but you should be able to modify the code to do that. I think moving it over to a new sheet cleans it up.

Amapola188 · Jun 14th 2018

Hi chavezm3. Thanks for this. Quite a different logic, I think I had started it the wrong way. The report headers are not needed.

I just tried it and can confirm that there are blocks with only one line and it stops at that block and gives an error at this line:

Code

Ws_1.Range(Ws_1.Cells(Cell.Offset(12, 0), 3), Ws_1.Cells(Cell.Offset(12, 0), 32)).Copy Ws_2.Cells(NextRwTable, 5)

The lines that need to come across always have only numbers in column A. So rather than going by empty or not empty at offset, can we go by that?

Thanks, Christine

chavezm3 · Jun 14th 2018

That's because my dumb self forgot to turn the cell reference into a row for the Cells description, i've updated and tested it out, it looks like it works.

I went with the empty or not because I wasn't sure how many rows would be populated so in order to set the beginning and end of the loop i had to make sure the .End(xlDown) method wouldn't include empty cells. Otherwise it would have gone from the single article, down to the Total line. This is just how I approached it, if you want to try the IsNumeric method I guess you could try a Do Until loop.

[vba]
Option Compare Text

Sub Report_to_Table()

Dim Cell As Object, Cellb As Object
Dim Ws_1 As Worksheet, Ws_2 As Worksheet
Dim LastRwReport As Long, RwStart As Long, RwEnd As Long, NextRwTable As Long
Dim strPlant As String, strPC As String, strStgLoc As String

Set Ws_1 = Worksheets("stock ageing")
Set Ws_2 = Worksheets.Add(After:=Worksheets(Worksheets.Count)) 'create new sheet to build table on

'find bottom of report output
LastRwReport = Ws_1.Cells(Rows.Count, "A").End(xlUp).Row

'bulid new table header
Ws_1.Range("G9:AF9").Copy Ws_2.Range("H1")
Ws_1.Range("G11:AF11").Copy Ws_2.Range("H2")
Ws_2.Range("A2").Value = "Article No"
Ws_2.Range("B2").Value = "Plant"
Ws_2.Range("C2").Value = "Profit Centre"
Ws_2.Range("D2").Value = "Storage Location"
Ws_2.Range("E2").Value = "Description"

For Each Cell In Ws_1.Range("A1:A" & LastRwReport)
If Cell.Value = "423S" Then
strPlant = Cell.Offset(4, 4).Value
strPC = Cell.Offset(5, 4).Value
strStgLoc = Cell.Offset(6, 4).Value

If Cell.Offset(13, 0).Value <> "" Then 'checks if at least 2 article numbers
Debug.Print Cell.Offset(12, 0).Row
RwStart = Cell.Offset(12, 0).Row
RwEnd = Cell.Offset(12, 0).End(xlDown).Row
For Each Cellb In Ws_1.Range(Ws_1.Cells(RwStart, 1), Ws_1.Cells(RwEnd, 1))
NextRwTable = Ws_2.Cells(Rows.Count, "A").End(xlUp).Row + 1
Ws_1.Cells(Cellb.Row, 1).Copy Ws_2.Cells(NextRwTable, 1)
Ws_1.Range(Ws_1.Cells(Cellb.Row, 4), Ws_1.Cells(Cellb.Row, 32)).Copy Ws_2.Cells(NextRwTable, 5)
Ws_2.Cells(NextRwTable, 2).Value = strPlant
Ws_2.Cells(NextRwTable, 3).Value = strPC
Ws_2.Cells(NextRwTable, 4).Value = strStgLoc
Next Cellb
Else ' if only one article then just copies the one
NextRwTable = Ws_2.Cells(Rows.Count, "A").End(xlUp).Row + 1
Ws_1.Cells(Cell.Offset(12, 0).Row, 1).Copy Ws_2.Cells(NextRwTable, 1)
Ws_1.Range(Ws_1.Cells(Cell.Offset(12, 0).Row, 4), Ws_1.Cells(Cell.Offset(12, 0).Row, 32)).Copy Ws_2.Cells(NextRwTable, 5)
Ws_2.Cells(NextRwTable, 2).Value = strPlant
Ws_2.Cells(NextRwTable, 3).Value = strPC
Ws_2.Cells(NextRwTable, 4).Value = strStgLoc
End If
End If
Next Cell

End Sub
[/vba]

Amapola188 · Jun 14th 2018

Hi chavezm9, that looks fantastic. I've noticed that further down it brings in lines starting with 423S, User and Report ID. Working on a big tender today so will cross-check next week and if I get bored, I might still try the IsNumeric method. Until then, if it ain't broke ...!!

Thank you so much and have a great weekend.

Christine

For Next Loop starting with numeric cell

Participate now!

Share