Need help on VBA Code

[Dfuhrman8]

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. 

[#2]

@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),
sCout,MOD(s,3)+1,sRout,QUOTIENT(s,3),sRin,MOD(sRout,r)+2,sCin,QUOTIENT(sRout,r)+2,
list,CHOOSE(sCout,INDEX(header,sCin),INDEX(labels,sRin),IF(INDEX(in,sRin,sCin)="",emptyCellTemp,INDEX(in,sRin,sCin))),
FILTER(list,INDEX(list,,3)<>emptyCellTemp))

 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.

[#3]

@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")
  ws.Range("e2:g10000").ClearContents
  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
    Wend
  
    iCol = iCol + 1
  Wend

[#4]

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.

[#5]

@mtarler 

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