Thanks. Works as intended. will try to make the Worksheet "Type" and the formula to be filled as dynamic . Thanks again for your patience and time spent to resolve.!
Thanks for your time and patience.
Pls find the attached image. Both sheets values to be combined together as a combined sheet.
as a last resort, could able to help out..
Thanks. The macro filters out based on the Column G, i.e vcol = 7.
Yes, i am looking for the formula to create the groups in the column F.
The five groups corresponds to the Column F and not I & J. If you filter Column F as per the image, you can get the groupings.
I & J i had indicated the name of the laminates. These laminates combine together form a group. Like (Laminate 01 & Laminate 02 ) or ( Laminate 2 & Laminate 02), etc.,
Hope it will be clear now..
Attached here with the excel file with the details.
manually we are doing as filter, text filter of 21091 HGL , so it filters out the 21091 HGL- 21091 HGL & Offwhite - 21091 HGL Categories. Then it has been copied to next sheets.
Like wise - 10858 SF
the code will be varies for each project, hence it has to be accessed from the array of Column Value, which has choosen,
Thanks for the help. will tryout as advised.
little bit brief.
Concept: the panel will be pasted by laminates on both sides ( either same laminates or two different laminates).
if both laminates (i.e color (21091 HGL -21091 HGL) (except off white - off white combination) are same or the one laminate is of color with combination of Off white( I.e 21091 HGL - Off white),both are grouped in the same new sheet.
Like that each unique color ( 10858 SF - 10858 SF) & (10858 SF - OFF WHITE) has to be grouped in the new sheet.
off white - off white combination alone grouped in another new sheet.
Like this output i am looking out.
Basically the unique color to be grouped together. (21091 - 21091 & 21091 - offwhite)
for that i am trying to access the my array variable, convert to text to column, get the unique values, and autofilter based on the unique values and copy them to the sheet. is it correct way to do that?
I have column with multiple unique values (which will be dynamic, not standard, as the user might enter different values) like following.
Offwhite - 21091 HGL
Off White - Off White
Offwhite - 10858 SF
10858 SF - 10858 SF
ex: finish code1 (off white) - finish code2 (21091 HGL)
finish code2 (21091 HGL) - finish code2 (21091 HGL)
finish code1 (off white) - finish code3 (10858 SF)
finish code3 (10858 SF) - finish code3 (10858 SF)
I would like to filter out as separate ( finishcode1 & finish code2, finish code2 & finish code)
Offwhite - 21091 HGL
Off White - Off White
and the following as separately.
Offwhite - 10858 SF
10858 SF - 10858 SF
and WPC as separately.
The current code filters, copy the filtered value, creates new sheet and paste the values for the each value in the array of values.
How to find solution for the above scenario.Code
' Segregating the values from rows in seperate sheet with lookup in column with more than 30 Characters Sub Splitdatabycol() ' declaring the variable for the last row Dim lr As Long ' declaring the variable for the Source worksheet Dim ws As Worksheet Dim vcol, i As Integer Dim icol As Long Dim myarr As Variant Dim title As String Dim titlerow As Integer ' declaring the variable for the Top Header Dim xTRg As Range ' declaring the variable for the Vertical Column Dim xVRg As Range Dim xWSTRg As Worksheet On Error Resume Next Set xTRg = Application.InputBox("Please select the header rows:", "Excel", "", Type:=8) If TypeName(xTRg) = "Nothing" Then Exit Sub ' Type:= 8, A cell reference, as a Range object Set xVRg = Application.InputBox("Please select the column you want to split data based on:", "Excel", "", Type:=8) If TypeName(xVRg) = "Nothing" Then Exit Sub 'Returns the column no of the selected column vcol = xVRg.Column Set ws = xTRg.Worksheet lr = ws.Cells(ws.Rows.Count, vcol).End(xlUp).Row title = xTRg.AddressLocal titlerow = xTRg.Cells(1).Row icol = ws.Columns.Count ws.Cells(1, icol) = "Unique" Application.DisplayAlerts = False If Not Evaluate("=ISREF('xTRgWs_Sheet!A1')") Then Sheets.Add(after:=Worksheets(Worksheets.Count)).Name = "xTRgWs_Sheet" Else Sheets("xTRgWs_Sheet").Delete Sheets.Add(after:=Worksheets(Worksheets.Count)).Name = "xTRgWs_Sheet" End If Set xWSTRg = Sheets("xTRgWs_Sheet") xTRg.Copy xWSTRg.Paste Destination:=xWSTRg.Range("A1") ws.Activate For i = (titlerow + xTRg.Rows.Count) To lr On Error Resume Next If ws.Cells(i, vcol) <> "" And Application.WorksheetFunction.Match(ws.Cells(i, vcol), ws.Columns(icol), 0) = 0 Then ws.Cells(ws.Rows.Count, icol).End(xlUp).Offset(1) = ws.Cells(i, vcol) End If Next myarr = Application.WorksheetFunction.Transpose(ws.Columns(icol).SpecialCells(xlCellTypeConstants)) ws.Columns(icol).Clear Dim sheetName As String For i = 2 To UBound(myarr) '"=*" & myarr(i) & "*", Operator:=xlAnd ws.Range(title).AutoFilter field:=vcol, Criteria1:=myarr(i) & "" ' Replace the below assignment to sheetName as you wish sheetName = Left(CStr(i - 1) & "_" & myarr(i), 30) If Not Evaluate("=ISREF('" & myarr(i) & "'!A1)") Then Sheets.Add(after:=Worksheets(Worksheets.Count)).Name = sheetName Else Sheets(sheetName).Move after:=Worksheets(Worksheets.Count) End If ws.Range("A" & titlerow & ":A" & lr).EntireRow.Copy Sheets(sheetName).Range("A1") Sheets(sheetName).Columns.AutoFit Next xWSTRg.Delete ws.AutoFilterMode = False ws.Activate Application.DisplayAlerts = True On Error Resume Next ActiveSheet.ShowAllData End Sub
i Have used the code which i had mentioned in the first post of the thread. that calculate the empty row above the starting row too
yours working fine. Thanks.
hi attached herewith
BUT all ranges can obviously have their own variables : i for Rows and j for Columns
at particular point of time only on range will be there in the worksheet, which will be anywhere..in the worksheet. as the user will enter in the any cells.
I have to check the no of rows, where the user has entered the data and use for further process with for loop
But this code works out for a static range of cells. But if the values are changing dynamically, means how to do that.
For Example scenario 1:
the range starts from A1: E5
How to find the number of rows in specified column of data range. i can able to find the total number of rows from the starting of A1 to the end of the datarange. But my data range starts from b4: d12. It returns 12 and not as 9. how to solve?
01. I am having range of data, would like to find the value greater than in the column P (say 3) of the particular cell, and insert the row above or below (number (say 3) times - 1) (=3-1), and copy & paste the entire row, in the inserted rows and the change the value of the P column for the pasted values as 1. Also change the value of three into one.
02. Also the values in the column Q has to be separated, with the delimiter comma (, ) and the same has to be pasted in the Q column of the inserted rows, with each unique value.
Where the occurrence is more than, the above things has to be happened.
Attached here with the sample data and expected output.
Could anyone help in this regard.
Thanks a lot jolivanes!
changing the value of ls to the row value work for the n rows . How to assign the variable 'ls' to get the number of rows from the starting cell F3 to the last row in with suitable datatype.Code
Sub Maybe() Dim codeArr, lengthArr, resultArr, lr As Long Dim k As Long, j As Long, i As Long, ls As Long Application.ScreenUpdating = False lr = Cells(Rows.count, 6).End(xlUp).Row ls = 4 codeArr = Range("F3:I" & lr).Value 'range of codes lengthArr = Range("J3:K" & lr).Value ' range of values ReDim resultArr(1 To UBound(codeArr) * 4, 1 To 2) k = 0 For j = 1 To 4 ' four columns of edgeband For i = 1 To UBound(codeArr) k = k + 1 resultArr(k, 1) = codeArr(i, j) Next i Next j k = 0 For j = 1 To 2 ' two columns of values length and width For i = 1 To UBound(lengthArr) k = k + 1 resultArr(k, 2) = lengthArr(i, j) resultArr(k + ls, 2) = lengthArr(i, j) Next i k = k + ls Next j Cells(3, 13).Resize(UBound(resultArr), 2) = resultArr Cells(2, 13).Resize(, 5).Value = Array("EB", "Length", "", "EB", "Total") Range(Cells(2, 13), Cells(Cells(Rows.count, 13).End(xlUp).Row, 13)).AdvancedFilter Action:=xlFilterCopy, _ CopyToRange:=Cells(2, 16), Unique:=True For j = 3 To Cells(Rows.count, 16).End(xlUp).Row For i = 3 To Cells(Rows.count, 13).End(xlUp).Row If Cells(i, 13).Value = Cells(j, 16).Value Then Cells(j, 16).Offset(, 1).Value = Cells(j, 16).Offset(, 1).Value + Cells(i, 13).Offset(, 1).Value Next i Next j Application.ScreenUpdating = True End Sub
Last thing, if there are 'n' number of rows means, how to incorporate in the code.
i tried inserted the following codeCode
but seems it has to be tweaked! could you pls help