Need help on VBA Code

Occasional Contributor

I have a worksheet that I am needing to create single row charges for any amounts that are listed for a company. 

Here is an example:


So Company "Discount Tire" needs to have two separate rows created to list out Training amount of $250 and another row listing Discount Tire for Cancellation amount of $500. What would be the best way to get this accomplished. I receive an excel report weekly and at times I could have one charge or I could have 10. But I have to create separate row/line charges for each expense listed under that Company and include that company name. Also, the report could list one company or list multiple companies. 

4 Replies

@Dfuhrman8 You COULD get a macro to do this but you could also just use in cell functions.  Here is an in-cell function that should work and someone else here could probably make one using the LAMBDA functions that is even smaller/easier

=LET(in,$A$1:$D$6,emptyCellTemp,"~-~",emptyCellTemp_Info,"this is a temp character string to differentiate empty cells from cells with a 0 value",
header,INDEX(in,1,),labels,INDEX(in,,1), r,ROWS(in)-1,c,COLUMNS(in)-1,s,SEQUENCE(r*c,3,0),

 Don't worry how big it is, the only thing you need to do is change that range from $A$1:$D$6 to cover your whole table (including header row and label column on the left) and it will spit out 3 rows of values:  Header Value,  Label Value,  table Value

In the attached I also have another formula if you wanted them joined into 1 text string (or you can just add TEXTJOIN() to the above.


@Dfuhrman8 you could use this - I dummied up a sample with multiple companies across the page


Output goes to columns E, F and G




Sub CreateData()
  Dim ws As Worksheet
  Dim iRow As Integer
  Dim iOutRow As Integer
  Dim iCol As Integer
  Dim sCompany As String
  Set ws = Sheets("Sheet1")
  iCol = 2
  iOutRow = 2
  'scroll through companys
  While ws.Cells(1, iCol) <> ""
    sCompany = ws.Cells(1, iCol)
    'scroll through Rows
    iRow = 2
    While ws.Cells(iRow, 1) <> ""
      If ws.Cells(iRow, iCol) <> 0 Then
        ws.Cells(iOutRow, 5) = sCompany
        ws.Cells(iOutRow, 6) = ws.Cells(iRow, 1)
        ws.Cells(iOutRow, 7) = ws.Cells(iRow, iCol)
        iOutRow = iOutRow + 1
      End If
      iRow = iRow + 1
    iCol = iCol + 1


BTW, I notice that your 'blanks' are all 0 value so in my LET() formula above you need to set emptyCellTemp to 0 instead of "~-~"
The point of that variable is IF the table has both blank values and 0 values and the 0 values are important as opposed to the blank values. In this case you want to ignore those 0 values.


Thank you! I was able to get it to work!