Excel report with increasing list of rows - excel

I need to build a report which lists products in column A and qty sold / revenue / units on hand in the next 3 columns. Something like this:
Products Qty Sold Revenue Units on Hand
-------- -------- ------- -------------
A 1 10 3
B 2 20 4
C 1 20 5
D 3 30 6
Ideally, i want to setup this report in a way that I can dump data in a data tab and have it populate here. I can easily set that up with a sumifs formula.
The problem i'm facing is: How do i deal with an expanding list of products in column A?
For example, next week there is a new product 'E' that has some sales and i need to be able to dynamically add it in. It'll be tough for me to add it in manually as, in the real report, there will be hundreds of products listed. I could setup a pivot table but i'm not comfortable doing that with the audience i'll be sharing the report with.
Let me know if this makes sense and if i need to provide any additional information to clarify this problem.
Thanks for your help, appreciate it!

If you don't want to use a pivot table, I'd say your best bet is to write a short macro to make sure every product on your data tab shows up in your report tag. For example:
Option Explicit
Sub CheckDataAndAddToReport()
Dim wsReport As Worksheet, wsData As Worksheet
Dim startRow As Long, endRow As Long, currRow As Long, addRow As Long
Dim missingCt As Long
Set wsReport = ActiveWorkbook.Sheets("Report") 'put the name of your Report sheet here
Set wsData = ActiveWorkbook.Sheets("Data") 'put the name of your Data sheet here
'startRow will be the first row with data in the data worksheet
startRow = 2
'set endRow to the last row with data in the data worksheet
endRow = wsData.Cells(wsData.Rows.Count, 1).End(xlUp).Row
'loop through all the rows of the data worksheet with data
For currRow = startRow To endRow
'check to see if the item on the current row is found in the reports page
If WorksheetFunction.CountIf(wsReport.Columns(1), wsData.Cells(currRow, 1).Value) = 0 Then
'if not, add it and the relevant formulas
addRow = wsReport.Cells(wsReport.Rows.Count, 1).End(xlUp).Row + 1
wsReport.Cells(addRow, 1).Formula = wsData.Cells(currRow, 1).Value
wsReport.Cells(addRow, 2).Formula = "" 'put whatever formulas you need to here
wsReport.Cells(addRow, 3).Formula = "" 'put whatever formulas you need to here
wsReport.Cells(addRow, 4).Formula = "" 'put whatever formulas you need to here
'keep a count of how many were added for reporting purposes
missingCt = missingCt + 1
End If
Next currRow
'show a message box with the results
If missingCt > 0 Then
MsgBox "A total of " & missingCt & " items were found in " & wsData.Name & " that were missing from " & wsReport.Name & " and were added.", _
vbInformation, _
"Results"
Else
MsgBox "No items were found to be missing from " & wsReport.Name & ".", _
vbInformation, _
"Results"
End If
End Sub

Related

Excel Data Row Consolidation

I'm trying to come up with a tool to be able to consolidate row data into one line item in Excel. Below is an example:
I want to be able to consolidate record 0604, with the staggered data, into one line item across and remove the duplicates.
Note: this is a limited sample. The real data set can contain more columns (up to 60) with the possibility of 20 duplicate ID that are staggered and needs to be consolidated.
The software that I'm extracting the data from provide this as an output. I'm unable to channel this through a SQL software due to limited access. I know SQL will make this a bit easier, but I was wondering if this can be done in Excel.
Scan up the sheet and compare each cell with the one below and copy from below if blank. Delete row below if it has the same ID
Option Explicit
Sub consolidate()
Const SHEET_NAME = "Sheet1"
Const NO_OF_COLS = 30
Dim wb As Workbook, ws As Worksheet
Dim irow As Long, iLastRow As Long, c As Long, count As Long
Set wb = ThisWorkbook
Set ws = wb.Sheets(SHEET_NAME)
iLastRow = ws.Range("A" & Rows.count).End(xlUp).Row
' scan up sheet
For irow = iLastRow - 1 To 2 Step -1
' if same id below
If ws.Cells(irow + 1, 1) = ws.Cells(irow, 1) Then
' scan across
For c = 1 To NO_OF_COLS
' if blank copy from below
If Len(ws.Cells(irow, c)) = 0 Then
ws.Cells(irow, c) = ws.Cells(irow + 1, c)
End If
Next
ws.Rows(irow + 1).Delete
count = count + 1
End If
Next
MsgBox iLastRow - 1 & " rows scanned" & vbCr & _
count & " rows deleted from " & ws.Name, vbInformation
End Sub
If I understand right you could do this with the concatenate function in excel to combine all of the cells together in one cell.
I believe this is what you were asking?
This is an example of how to use that:
=CONCAT(A1,"-",B1)
And whatever cell this is typed into will have cell "A1-B1" as a value (with the values within those cells instead of the cell names).

How to Transfer ListBox selection to excel sheet?

I have a UserForm with a single selection ListBox (lstKitResult) that is populated with data from the sheet Kit_database. The user can search using a keyword and only filtered data is displayed. After the user makes a selection I would like to transfer this information to cells B3 and C3 in the sheet Update_kit. The ListBox shows 5 columns but I would like to transfer over values from only 2 of these columns (first two columns). This is the code I am currently using:
Private Sub cmdUpdateKit_Click()
Dim ws As Worksheet
Set ws = Sheets("Update_kit")
Dim nextAvailableRow As Long
Dim i As Long
For i = 0 To lstKitResult.ListCount - 1
nextAvailableRow = ws.range("B" & Rows.count).End(xlUp).Row + 1
ws.range("B" & nextAvailableRow) = lstKitResult.Column(0, i)
ws.range("C" & nextAvailableRow) = lstKitResult.Column(1, i)
Next i
Me.Hide
End Sub
It transfers over all filtered results and all columns from the ListBox to Update_kit rather than just the selection and its associated data. Also, the info is dumped into the empty row rather than cells B3 and C3 as I mentioned.
I'm still fairly new to VBA and cannot figure out where the issue is. Can someone advise how to fix this? Much appreciated.
Am assuming this is a userform?
You can do it thus. Loop through each item until you find the selected one and then transfer the relevant columns (zero-based).
Private Sub CommandButton1_Click()
Dim ws As Worksheet
Set ws = Sheets("Update_kit")
Dim i As Long, nextAvailableRow As Long
nextAvailableRow = ws.Range("B" & Rows.Count).End(xlUp).Row + 1
For i = 0 To Me.lstKitResult.ListCount - 1
If Me.lstKitResult.Selected(i) Then
ws.Range("B" & nextAvailableRow) = Me.lstKitResult.List(i, 0) 'column 1
ws.Range("C" & nextAvailableRow) = Me.lstKitResult.List(i, 1) 'column 2
Exit For 'no need to carry on searching
End If
Next i
End Sub

Transferring a long list of data to specific sheets based on selection in first cell of each row

I'm trying to automate a list of data to be transferred to specific sheets by adding new rows, all within the same workbook.
Ideally I wouldn't like to limit the number of rows of data to be transferred as there could be a large amount of data coming in. I have tried the following code but it only works for a single row of data, can anyone help improve this code to transfer multiple rows?
Sub AddValues()
'Dimension variable and declare data type
Dim i As Single
'Save row number of cell below last nonempty cell
i = Worksheets("" & Range("A2")).Range("B" & Rows.Count).End(xlUp).Row + 1
'Save input values to selected worksheet
Worksheets("" & Range("A2")).Range("B" & i & ":P" & i) = _
Worksheets("Form").Range("B2:P10").Value
'Clear input cells
Worksheets("Form").Range("B2:P10") = ""
'Stop macro
End Sub
Sample output of what I hope it do:
Try this one:
EDITED. That one is the last version, fixin the shifting problems from the previous one.
I just add a few comments so in the future you can modify it easily.
Option Explicit
Sub AddValues()
'Dimension variable and declare data type
Dim i As Long 'Counter
Dim j As Long 'Counter
Dim NextRow As Long 'Last Row used
'Save input values to selected worksheet
For i = 2 To Worksheets("Form").UsedRange.SpecialCells(xlCellTypeLastCell).Row 'For Each Row on Sheet "Form"
'If there is no item still copied (Problem with merged cells)
If Worksheets(Range("A" & i).Value2).Cells(1048576, 2).End(xlUp).Row < 7 Then
For j = 2 To Worksheets("Form").UsedRange.SpecialCells(xlCellTypeLastCell).Column
Worksheets(Range("A" & i).Value2).Cells(7, j).Value2 = Worksheets("Form").Cells(i, j).Value2
Next j
'If there is just one item still copied (Problem with merged cells)
ElseIf Worksheets(Range("A" & i).Value2).Cells(1048576, 2).End(xlUp).Row = 7 Then
For j = 2 To Worksheets("Form").UsedRange.SpecialCells(xlCellTypeLastCell).Column
Worksheets(Range("A" & i).Value2).Cells(8, j).Value2 = Worksheets("Form").Cells(i, j).Value2
Next j
'For all remaining scenarios
Else
NextRow = Worksheets(Range("A" & i).Value2).Cells(1048576, 2).End(xlUp).Row
For j = 2 To Worksheets("Form").UsedRange.SpecialCells(xlCellTypeLastCell).Column
Worksheets(Range("A" & i).Value2).Cells(NextRow + 1, j).Value2 = Worksheets("Form").Cells(i, j).Value2
Next j
End If
Next i
'Clear input cells from B2 cell until the last Cell (not required to pay attention to the range)
Range(Cells(2, 2), Worksheets("Form").UsedRange.SpecialCells(xlCellTypeLastCell)) = ""
'End macro
End Sub
Hope it helps!

VBA How to search multiple columns for specific value and return an offset cell to modify

I'm creating an inventory list for several characters. I'm trying to create an entry form above the list that will search the list for if a character by that name is already carrying that item. If they are, it should add 1 to the Quantity Column. If not, it should add the data entered to the bottom of the list
I've tried several different codes, but my main issue is that I don't know much. I've just started learning and I've gone based on what I can find. This is primary variants of the code I've used. Might be wrong.
Sub Test3()
Dim i As Long
Dim j As Long
Dim lastrow As Long
Dim ws As Worksheet
Set ws = Sheets("Inventories")
Set ws2 = Sheets("Inventories")
For i = 9 To 9
If IsEmpty(ws.Range("A" & i)) Then
Exit For
End If
For j = 12 To 50000
If IsEmpty(ws2.Range("A" & j)) Then
Exit For
End If
If ws.Range("A" & i).Value = ws2.Range("A" & j).Value Then
If ws.Range("B" & i).Value = ws2.Range("B" & j).Value Then
Exit For
End If
End If
Next j
Next i
MsgBox ("Finished ")
End Sub
The typical result is that it fails to give any result whatsoever with the values listed on my sheet here
It should be testing cells A9&B9 to find a match below. So if spellbook is in B9, it should find Adrys in A20 and Spellbook in B20, then change the quantity in F20 and change it to 2 by adding 1 to the existing 1.

Excel Misaligned Timestamps

[Edited]
I have a Excel workbook (.xlsx) with two worksheets (Sheet 1 & Sheet 2). Sheet 1 has 7 columns of data (each with about 70k rows) while Sheet 2 only has 5 columns with about 250-500 rows. The first column of each sheet contains a timestamp of when the data was collected in the format (yyyy-mm-dd_hh:mm:ss).
The discrepancy is that the data in Sheet 1 has data points spaced at 8 second intervals. Sheet 2, however, has sporadic data entries. There might be 4 or 5 entries that happen in a burst (say 5 second interval) and then not another entry for another couple of hours.
What I'd like to do is reorganize Sheet 2 so that the timestamps align with Sheet 1. The reason for this is that when I graph the data in sheet 1, the visualization looks appropriate because the data is evenly spaced throughout. However, I can not graph the data in Sheet 2 the same way because the data points occur at sporadic intervals.
I'm comfortable in C# and considering trying to create a program which will read in a csv file of each sheet and do the batch processing... but even there I'm a bit stuck as to what the proper procedure would be. Is there a way this can be handled directly in Excel? Any advice would be welcome.
A bit of background. I tested this on three sheets. First sheet has 100k dates with 8-second intervals. Second sheet, I have 5 columns of 300 data points, with first column containing the dates with sporadic intervals. I've decided against mangling the second sheet so my output is in a third sheet for testing purposes.
Our logic is locating the largest value that's smaller than our target date. This way, we're inside the 8 seconds between this located date and the next one. We then get that value's row from the first sheet, then we use that row as the same row number in our results sheet. We then "transfer" the values from the second sheet to the proper row in the results sheet.
Runtime is negligible on my machine. Hopefully, this runs for you properly as well. Kindly test on a copy of your workbook.
Sub Align()
Dim RefWS As Worksheet, ListWS As Worksheet, ResWS As Worksheet
Dim RngOne As Range, RngTwo As Range
Dim RngVal As Variant, Elem As Variant
Dim LRowOne As Long, LRowTwo As Long, LRowThree As Long
Dim LocRow As Long, RowCt As Long
Dim PopRng As Range, StartRow As Long
With ThisWorkbook
Set RefWS = .Sheets("Sheet1") 'Modify as necessary.
Set ListWS = .Sheets("Sheet2") 'Modify as necessary.
Set ResWS = .Sheets("Sheet3") 'Modify as necessary.
End With
LRowOne = RefWS.Range("A" & Rows.Count).End(xlUp).Row
LRowTwo = ListWS.Range("A" & Rows.Count).End(xlUp).Row
'Make sure to change based on whether you have headers or not.
Set RngOne = RefWS.Range("A1:A" & LRowOne) 'Modify as necessary.
Set RngTwo = ListWS.Range("A1:A" & LRowTwo) 'Modify as necessary.
RngVal = RngTwo.Value
'Change RowCt to 2 if you have headers.
RowCt = 1
For Each Elem In RngVal
LocRow = Application.Match(CDbl(Elem), RngOne, 1)
ResWS.Range("A" & LocRow & ":E" & LocRow).Value = ListWS.Range("A" & RowCt & ":E" & RowCt).Value
RowCt = RowCt + 1
Next Elem
'Autopopulate.
With ResWS
LRowThree = .Range("A" & Rows.Count).End(xlUp).Row
Do
StartRow = .Range("A" & LRowThree).End(xlUp).Row
If StartRow > 1 Then StartRow = StartRow + 1
Set PopRng = .Range("A" & StartRow & ":E" & LRowThree)
.Range("A" & LRowThree & ":E" & LRowThree).Copy
PopRng.PasteSpecial xlPasteValues
LRowThree = StartRow - 1
Loop Until StartRow = 1
End With
Application.CutCopyMode = False
End Sub
It's also important to note that if two values are matched, it's going to get the latest value rather than the closest one. Let me know first what happens to your data after running this.
EDIT: Code updated as per chat.

Resources