Alright for this project I am trying to take columns headers and combine them in row headers in one column. For instance
There a column header plant store it has rows with corresponding data tr1, tr2, tr3.
I want to make one full column with the data so it appears like this "plant store tr1", "Plant store tr2" etc...
this is the code I have so far.
J represents an arbitrary range that I want all the data to fill
X represents the location of all the tr1, tr2s, I want added to the end of plant store
plant store is located at J15 in detailed ratings.
Sub Double_column_method()
Dim J As Variant
Dim x As Variant
Set J = Range("A6:A400")
Sheets("Sheet2").Select
Range("A6").Select
For x = Sheets("Detailed Ratings").Range("J15") To Sheets("Detailed Ratings").Range("BQ15")
If J.Value <> "" Then J.Value = x&(Sheets("Detailed Ratings")).Range("I16")
Next
End Sub
Thank you any help is appreciated.
If I'm reading your post correctly, I think the following is what you need. It can be done without VBA. Type the formula in yellow and copy down/across.
Sub test()
Row = Cells(Rows.Count, "A").End(xlUp).Row
r = Row - 15
Column = Cells(16, Columns.Count).End(xlToLeft).Column
c = Column - 9
For i = 1 To r
For J = 1 To c
n = n + 1
Cells(n, "BU") = Cells(i + 15, "I") & Cells(15, J + 9)
Next J
Next i
This solved it for me, produced a clean list of all my headings combined.
Related
expanding off a question I asked previously, but now I'm a little farther ahead thanks to help from you fine folks and from other sources.
Basically I can pull reports from my company server, they are exported in spreadsheet format where each row is a report, and each column is info about the report (report count, date made, report title, etc), the column I am concerned with has a 4 digit code identifying the group that report came from (A205, A206, B208, Q404, there are thousands) Lets call this column the "Report Number"
I am currently using VLOOKUP to find the code on a reference sheet, and then return the name of the group that code is associated with, so if the code is "A205", the formula will instead return "A-TEAM" in the cell. (I have this paired with a macro which does it for hundreds of rows at once, and fills in name in the next empty column)
Right now this works great...IF there is only one code in the "Report Number" column. My problem arises when a report is completed by multiple groups separated by a comma. So in the "Report Number" column, it might have "A205, A206, B208" and I need the formula to output ALL the decoded names in the same format (I.E. "A Team, B Team, C Team) instead of an error, or just the first one.
So, is there a way to do this with VLOOKUP? without nesting IF functions over and over. Or do I need to modify my Macro?
Here is my current macro that works (when I change the parameters to match my worksheet names and whatnot) you can see where the vlookup formula is entered.
Option Explicit
Sub CustomerCodeLookup()
Dim LastRow As Long
Dim LastColumn As Long
Dim RNColumn As Long
Dim RNFirstCell As String
'identify last row of data
LastRow = Cells(Rows.Count, 1).End(xlUp).Row
'get first blank column (by assuming first blank cell in row 1 is the first blank column)
LastColumn = Cells(1, 1).End(xlToRight).Column + 1
'find the column that has "Report Number"
RNColumn = Range("1:1").Find("ReportNumber", LookIn:=xlValues).Column
'Relative address of first cell in Report Number column for use in the formula
RNFirstCell = Cells(2, RNColumn).Address(False, False)
'Add header to the lookup column
Cells(1, LastColumn) = "Group Name"
'insert formula from row 2 until the last data row
Range(Cells(2, LastColumn), Cells(LastRow, LastColumn)) = "=VLOOKUP(LEFT(" & RNFirstCell & ", 5),'C:\Path\to\pulled workbook\[Codes.xlsm]Codereference'!$A:$O,2,0)"
'Remove formula from cells
Range(Cells(2, LastColumn), Cells(LastRow, LastColumn)) = Range(Cells(2, LastColumn), Cells(LastRow, LastColumn)).Value
End Sub
You don't really want to be using VLOOKUP to solve this. Depending on what version of Excel you have, any of the following will be better approaches
Pull all the data into VBA using a Variant Array and use Array
manipulation
Pull all the data into VBA using a Variant Array and use Scripting Dictionaries
If you've got Excel 2016 or laterUse, use PowerQuery to pull the data into Excel, and shape it how you need it right in the PowerQuery interface.
If you've got Excel 2013 or later, import the separate tables into the DataModel and join them on the common field, so that you can use a PivotTable to do the reporting you describe. (You can do this even if you don't have the PowerPivot add-in in the SKU of Excel you have installed)
Note that both PowerQuery and PowerPivot are available as a free addin if you're running a version between 2010 and the dates I mention above.
PowerQuery and PowerPivot are by far the easiest way to tackle your issue, and there are plenty of resources on the net and videos on YouTube to get you started.
As you don't actually need the formula and to give a try to jeffreyweir array/dictionary suggestion :
Sub CustomerCodeLookup()
Dim P1 As Range, P2 As Range
Dim T2()
Set D1 = CreateObject("scripting.dictionary")
Set P1 = ActiveSheet.UsedRange
Set P2 = Workbooks("Codes.xlsm").Sheets("Codereference").UsedRange
T1 = P1
T3 = P2
For i = 1 To UBound(T3): D1(T3(i, 1)) = T3(i, 2): Next i
For i = 1 To UBound(T1, 2)
If T1(1, i) Like "ReportNumber" Then RN = i
Next i
a = 1
For i = 2 To UBound(T1)
ReDim Preserve T2(1 To a)
St1 = Split(Trim(T1(i, RN)), ",")
For j = 0 To UBound(St1)
T2(a) = T2(a) & ", " & D1(St1(j))
Next j
T2(a) = Mid(T2(a), 3)
a = a + 1
Next i
Range("A1").End(xlToRight).Offset(1, 1).Resize(a - 1) = Application.Transpose(T2)
End Sub
EDIT :
Sub CustomerCodeLookup()
Dim P1 As Range, P2 As Range
Dim T2()
Set D1 = CreateObject("scripting.dictionary")
Set P1 = ActiveSheet.UsedRange
Set P2 = Workbooks("Codes.xlsm").Sheets("Codereference").UsedRange
T1 = P1
T3 = P2
'Line below feeds the dictionary as D1(Key)=Item where Key (T3(i, 1)) is first used column of Workbooks("Codes.xlsm").Sheets("Codereference") and Item (T3(i, 2)) second column
For i = 1 To UBound(T3): D1(T3(i, 1)) = T3(i, 2): Next i
For i = 1 To UBound(T1, 2)
If T1(1, i) Like "ReportNumber" Then RN = i
Next i
a = 1
For i = 2 To UBound(T1)
ReDim Preserve T2(1 To a)
St1 = Split(Trim(T1(i, RN)), ",")
For j = 0 To UBound(St1)
T2(a) = T2(a) & ", " & D1(Left(Trim(St1(j)), 5))
Next j
T2(a) = Mid(T2(a), 3)
a = a + 1
Next i
Range("A1").End(xlToRight).Offset(1, 1).Resize(a - 1) = Application.Transpose(T2)
Range("A1").End(xlToRight).Offset(0, 1) = "Group Name"
End Sub
I am new to VBA and am trying to create a report template for work. I also want to see how this would be coded for my own personal understanding instead of using a formula.
Put simply I have a variable set of values in column A and dates in column B. Column D is a variable range of dates (user input. I would like to have this as an array within my code.)
I would like to sum column A while excluding the dates specified in column D, and have this sum output into cell G1. I have attached a picture below.
Thanks in advance!
Picture of the sheet
Try out this code, this is self explanatory.
Sub sumVariables()
Dim i As Long, j As Long, sum As Long, match As Boolean
sum = 0
match = False
For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
For j = 2 To Cells(Rows.Count, 4).End(xlUp).Row
If Cells(i, 2) = Cells(j, 4) Then
match = True
End If
Next j
If match = False Then
sum = sum + Cells(i, 1)
End If
match = False
Next i
Cells(1, 7) = sum
End Sub
This code would work for n number of rows in your sheet and give the total in G1. Let me know if you need any help.
The code below is part of a larger form. What I'm trying to do is:
On sheet 2 (Data List) filter data based on column 1
Based on user selected items in a listbox pull out data from the filtered range from columns 2 and 3 for specific rows and paste into sheet 1 (JHA)
I know which rows the data is in only within the filtered list because I'm storing it in a 2D array dataArr
Sheets("Data List").Select
With Worksheets("Data List").Range("A1", Sheets("Data List").Range("C1").End(xlDown))
.AutoFilter field:=1, Criteria1:=UserForm1.ListBox3.List(k) 'filter data based on user listbox selection
For j = 0 To UserForm1.ListBox1.ListCount - 1 'Find user selection from LB3 in LB1 to match filtered data order
If UserForm1.ListBox3.List(k) = UserForm1.ListBox1.List(j) Then Exit For
Next j
For h = 0 To UBound(dataArr, 2)
If dataArr(j, h) = 1 Then 'If the user has selected they want this data then add it to the array
Set myRange = Sheets("Data List").AutoFilter.Range().SpecialCells(xlCellTypeVisible)
myRange.Select
arr1(l) = myRange.Cells(h + 2, 2)
arr2(l) = myRange.Cells(h + 2, 3)
l = l + 1
End If
Next h
.AutoFilter
After this bit of code I redimension the array and paste the data on the other sheet. My issue is that myRange.cells is selecting from the unfiltered data. So for example say my filtered data set includes rows 7, 11, 15 and 21. When I filter it and set myRange it highlights 4 rows plus the header. However, when I use cells(2, 2) I get the unfiltered row 2 column 2 data, not for my filtered data set. I'm sure I'm missing something simple but I can't see what it is.
Filtered range can be (well, it almost always is!) a not contiguous one, so you have to iterate through it and pitch the nth value
You may want to use this function:
Function GetFilteredCellsNthValue(filteredRng As Range, nthVal As Long) As Variant
Dim iVal As Long, Dim cell As Range
iVal = 1
ForEach cell in filteredRng
If iVal = nthVal Then Exit For
iVal = iVal + 1
Next
GetFilteredCellsNthValue = Iif(iVal>filteredRng.Count, CVErr(xlErrValue), cell.Value)
End Function
That could be used in your "main" code as follows
arr1(l) = GetFilteredCellsNthValue( .Resize(,1).Offset(.Rows.Count - 1,1).SpecialCells(xlCellTypeVisible)), h + 2)
arr2(l) = GetFilteredCellsNthValue( .Resize(,1).Offset(.Rows.Count - 1,2).SpecialCells(xlCellTypeVisible)), h + 2)
Already for some days, I'm searching the internet to find the correct code/help for my application.
The situation: If a certain product for a certain customer is done, column 9 give "Ready". When this happens, the whole row has to move to sheet 2 in a kind of 'history'-list and disappear out of the 'up-to-date'-list.
My code is the next:
Sub MoveDelete()
Dim i As Integer
Dim y As Integer
Application.ScreenUpdating = False
i = ActiveSheet.UsedRange.Rows.Count
For y = i To 1 Step -1
If Cells(y, 9).Value = "Mag weg" Then
Cells(y, 9).EntireRow.Cut Worksheets(2).Cells(i, 1)
Cells(y, 1).EntireRow.Delete
i = i + 1
End If
Next
End Sub
This code is working but gives other problems. Suppose today my range is 40 and 3 rows should be moved to the second worksheet, they are placed on row 40,39 and 38 (instead of 1,2,3 which would be better). But for example, tomorrow I add 5 rows in the up-to-date list and 4 old rows can be removed again, it will overwrite the previous ones (but I would like to have them on 4,5,6 and 7).
My goal is to have a list that I can update every day so the production line has a clear view of the workload and on the second page a list with all products/customerinformation that are done the last month.
I hope somebody can help me out here. If there are more questions, feel free to ask! Thanks a lot!
You can append the new moved rows to the end of what already exists in sheet2.
Sub MoveDelete()
Dim i As Integer, y As Integer, j as Integer
Application.ScreenUpdating = False
'Find first free row in sheet2
j = Worksheets(2).cells(Rows.Count, 9).End(xlUp).Row + 1
i = ActiveSheet.cells(Rows.Count, 9).End(xlUp).Row
For y = i To 1 Step -1
If Cells(y, 9).Value = "Mag weg" Then
Rows(y).Copy Worksheets(2).Rows(j)
Rows(y).EntireRow.Delete
j = j + 1
End If
Next
Application.ScreenUpdating = True
End Sub
I have two sheet tabs.i.e. Raw Data and Overview
I was looking for code which would copy and paste data in the Overview tab based on the names in Column B and dates in row 3:3.
The table in Raw Data tab has names in column A, dates in Column B and Value in Column C
The table in Overview looks like this
01/04/2015 02/04/2015 03/04/2015 04/04/2015 05/04/2015
a
b
c
d
I understand that there are formulas like Vlookups, Index, sumifs but I would prefer the solution in VBA as the data is extensive
As a matter of example only, please check the code below, it has sections that create things for you. It should work for your problem, but certainly is not using the best practices specially while looking at the performance side of the problem.
To run this code, you have to check and modify the worksheet names in the two code lines starting with "Set" and change the column and row indexers to fit your needs.
Also, it is important to say that, if you have repeated values on your first two columns, this procedure might not work as expected.
Sub DoYourJob()
Dim x As Integer
Dim y As Integer
Dim z As Integer
Dim sourceWorksheet As Worksheet
Dim targetWorksheet As Worksheet
Set sourceWorksheet = ThisWorkbook.Worksheets("YourSourceWorksheetName")
Set targetWorksheet = ThisWorkbook.Worksheets("YourTargetWorksheetName")
Dim existing As Boolean
'Let the macro read an create the table
'Creating the rows
For x = 2 To sourceWorksheet.Cells(sourceWorksheet.Rows.Count, 1).End(xlUp).Row
existing = False
For y = 2 To targetWorksheet.Cells(targetWorksheet.Rows.Count, 1).End(xlUp).Row
If targetWorksheet.Cells(y, 1).Value = sourceWorksheet.Cells(x, 1).Value Then
existing = True
Exit For
End If
Next y
If Not existing Then
targetWorksheet.Cells(targetWorksheet.Cells(targetWorksheet.Rows.Count, 1).End(xlUp).Row + 1, 1).Value = sourceWorksheet.Cells(x, 1).Value
End If
Next x
'Creating the columns
For x = 2 To sourceWorksheet.Cells(sourceWorksheet.Rows.Count, 1).End(xlUp).Row
existing = False
For y = 2 To targetWorksheet.Cells(1, targetWorksheet.Columns.Count).End(xlToLeft).Column
If targetWorksheet.Cells(1, y).Value = sourceWorksheet.Cells(x, 2).Value Then
existing = True
Exit For
End If
Next y
If Not existing Then
targetWorksheet.Cells(1, targetWorksheet.Cells(1, targetWorksheet.Columns.Count).End(xlToLeft).Column + 1).Value = sourceWorksheet.Cells(x, 2).Value
End If
Next x
'Iterate to fill the table
For z = 1 To sourceWorksheet.Cells(sourceWorksheet.Rows.Count, 1).End(xlUp).Row
For y = 2 To targetWorksheet.Cells(targetWorksheet.Rows.Count, 1).End(xlUp).Row
If targetWorksheet.Cells(y, 1).Value = sourceWorksheet.Cells(z, 1).Value Then
For x = 2 To targetWorksheet.Cells(1, targetWorksheet.Columns.Count).End(xlToLeft).Column
If targetWorksheet.Cells(1, x).Value = sourceWorksheet.Cells(z, 2).Value Then
targetWorksheet.Cells(y, x).Value = sourceWorksheet.Cells(z, 3).Value
Exit For
End If
Next x
Exit For
End If
Next y
Next z
End Sub
If you have trouble understanding or using the code, please leave a comment.