i have an excel table with +19k lines.
Let's assume table has 2 columns ( Departmant,id).
there are 25 departments that each has unique id.
What formula can i use to get each of them's id correctly.
i tried using if, but i guess it doesnt work with + 25 if's in it..
is there any easy way to do it ?
i'm a beginnner and i'm working on this table for 3 days!.
Taken from MrExcel.com. Untested
Sub FindDistinctValues()
Dim LastRowFrom As Long
Dim LastRowTo As Long
Dim i As Long, j As Long
Dim temp As Integer
Dim found As Boolean
'determines the last row that contains data in column A
LastRowFrom = Range("A" & Rows.Count).End(xlUp).Row
'Loop for each entry in column A
For i = 2 To LastRowFrom
'get the next value from column A
temp = Range("A" & i).Value
'Determine the last row with data in column B
LastRowTo = Range("B" & Rows.Count).End(xlUp).Row
'initialize j and found
j = 1
found = False
'Loop through "To List" until a match is found or the list has been searched
Do
'check if the value exists in B column
If temp = Range("B" & j).Value Then
found = True
End If
'increment j
j = j + 1
Loop Until found Or j = LastRowTo + 1
'if the value is not already in column B
If Not found Then
Range("B" & j).Value = temp
End If
Next i
End Sub
Related
The project consist to add lines in a new table based on value coming from 2 different table (or Excel file).
There are 3 files, called by :
Reference : the content of the file will not change
Data : the content of the file will always change
Result : the content of the file is a combination of the Reference and Date based on my request below. It is want I need.
I create 3 files, all manually with some value in order to help you to understand, called Example_Reference, Example_Data and Example_Result.
What as to be done:
First step:
Write a new line (in the new file/table) and copy exactly all the cells of the first line of Reference file.
Second step:
We take the content of the cell (column A) of Reference file (same line that point 1.) and we look in the Data file if one cell at least (column A) is the exactly the same :
a. If NOT : Do nothing, and continue for next line of the Reference file (do that until end of line of the Reference line (not end of Excel, but when no more line with something inside))
b. If YES :
i. Look how many line are with the same value (text) in the column A (Data file), create (in the Result file) a number of line equal to the number of same value and copy all data and line from Data file (for the same Column A of course).
ii. Modify in the first line (created on point 1) the cell (column R) with the different value of the column R added in point 2.b. of each line with specific “;” as in example. (T1;T2;T3… if T1 T2 and T3 are on the line).
iii. For main line (where a Product is written, like in the Reference file and line), on column N, it should be the sum of all the number below (0, 3 or 😎 for all the subline (Variant).
3. If sum = 0, write FALSE on column K. If sum is different from 0, write on column K TRUE.
c. Do that until we finish to read all the line of the Reference
Below are the Images of example three files:
Reference
Data
Result
So far I have done with the First Step as follows:
Dim cel As Range
Dim oFoundRng As Range
Range("A1").End(xlUp).Select ' looking for first empty cell on result sheet
With Workbooks("Example_Reference").Worksheets("Feuil1")
With .Range("a1", .Cells(.Rows.Count, "a").End(xlUp))
For Each cel In .SpecialCells(xlCellTypeConstants) ' loop through referenced range not empty cells
.Range(cel.Address).EntireRow.Copy Workbooks("result").Worksheets("feuil1").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
Next
End With
End With
Now I need to take the content of the cell (column A) of Reference file (same line that point 1.) and we look in the Data file if one cell at least (column A) is the exactly the same.
can you guys help?
I will update my question as I go along ...
Here you have, let me know if works as you expected :)
Just set the workbook variables with your names or paths.
The sub is ready to work with the three workboos already opened but if
you want the macro to open the wbks just add workbooks.open method at the beginning.
Sub ProcessData()
'Workbook ans worksheet declaration
Dim referenceWbk As Workbook
Set referenceWbk = Workbooks("Reference.xlsx")
Dim dataWbk As Workbook
Set dataWbk = Workbooks("Data.xlsx")
Dim exampleWbk As Workbook
Set exampleWbk = Workbooks("Example.xlsm")
Dim referenceWsh As Worksheet
Set referenceWsh = referenceWbk.Sheets(1)
Dim dataWsh As Worksheet
Set dataWsh = dataWbk.Sheets(1)
Dim exampleWsh As Worksheet
Set exampleWsh = exampleWbk.Sheets(1)
'Loop reference workbook
Dim exampleLastRow As Long: exampleLastRow = 1
Dim i As Long
For i = 1 To referenceWsh.Range("A" & referenceWsh.Rows.Count).End(xlUp).Row
referenceWsh.Range("A" & i).EntireRow.Copy
exampleWsh.Range("A" & exampleLastRow).PasteSpecial xlPasteValues
'loop data wsh
Dim coicidenceCount As Long: coicidenceCount = 0
'Delete header in column N, R and K
exampleWsh.Range("N" & exampleLastRow).Value = ""
exampleWsh.Range("R" & exampleLastRow).Value = ""
exampleWsh.Range("K" & exampleLastRow).Value = ""
Dim j As Long
For j = 1 To dataWsh.Range("A" & dataWsh.Rows.Count).End(xlUp).Row
If dataWsh.Range("A" & j).Value = exampleWsh.Range("A" & exampleLastRow).Value Then
coicidenceCount = coicidenceCount + 1
exampleWsh.Range("A" & exampleLastRow + coicidenceCount).Value = dataWsh.Range("A" & j).Value
exampleWsh.Range("R" & exampleLastRow + coicidenceCount).Value = dataWsh.Range("B" & j).Value
exampleWsh.Range("N" & exampleLastRow + coicidenceCount).Value = dataWsh.Range("C" & j).Value
exampleWsh.Range("B" & exampleLastRow + coicidenceCount).Value = "Variant"
'add value to R header (plus ';')
exampleWsh.Range("R" & exampleLastRow).Value = exampleWsh.Range("R" & exampleLastRow).Value & dataWsh.Range("B" & j).Value & ";"
'add value to N header
exampleWsh.Range("N" & exampleLastRow).Value = exampleWsh.Range("N" & exampleLastRow).Value + dataWsh.Range("C" & j).Value
End If
Next j
'add value to K header
If exampleWsh.Range("N" & exampleLastRow).Value > 0 Then
exampleWsh.Range("K" & exampleLastRow).Value = True
Else
exampleWsh.Range("K" & exampleLastRow).Value = False
End If
'delete last ';' from R header
If exampleWsh.Range("R" & exampleLastRow).Value <> "" Then
exampleWsh.Range("R" & exampleLastRow).Value = Left(exampleWsh.Range("R" & exampleLastRow).Value, Len(exampleWsh.Range("R" & exampleLastRow).Value) - 1)
End If
exampleLastRow = exampleWsh.Range("A" & exampleWsh.Rows.Count).End(xlUp).Row + 1
Next i
End Sub
Try the next code, please. We cannot see which is the last column of 'Reference' sheet, but looking to the 'Result' one I assumed that it should be column "Q:Q":
Sub testProcessThreeWorkbooks()
Dim wsRef As Worksheet, wsData As Worksheet, wsRes As Worksheet
Dim lastRR As Long, lastRD As Long, rowRes As Long, i As Long, j As Long
Dim count As Long, k As Long, arr, arrT
Set wsRef = Workbooks("Example_Reference.xlsx").Sheets(1) 'use here the necessary sheet
Set wsData = Workbooks("Example_Data.xlsx").Sheets(1) 'use here the necessary sheet
Set wsRes = Workbooks("Example_Result.xlsx").Sheets(1) 'use here the necessary sheet
lastRR = wsRef.Range("A" & rows.count).End(xlUp).row 'last row of 'Reference` sheet
lastRD = wsData.Range("A" & rows.count).End(xlUp).row 'last row of 'Data' sheet
rowRes = 1 'Row of the 'Result' sheet, where the first processed line should be placed
For i = 1 To lastRR 'iterate between all existing cells of A:A 'Reference' sheet column
wsRes.Range("A" & rowRes).Resize(1, 17).Value = wsRef.Range("A" & i, "Q" & i).Value 'copy the row to be processed
count = WorksheetFunction.CountIf(wsData.Range("A1:A" & lastRD), wsRef.Range("A" & i).Value) 'count the occurrences
If count > 0 Then 'if any occurence exists:
ReDim arrT(count - 1) 'redim the array keeping 'T' type data
ReDim arr(count - 1) 'redim the array to keep the values from C:C column
k = 0 'initialize the variable to fill in the above arrays
For j = 1 To lastRD 'iterate between all existing cells of A:A 'Data' sheet column
If wsRef.Range("A" & i).Value = wsData.Range("A" & j).Value Then 'for occurrences:
arrT(k) = wsData.Range("B" & j).Value 'load 'T' type values
arr(k) = wsData.Range("C" & j).Value: k = k + 1 'Load values of C:C column
End If
Next j
With wsRes 'process the 'Result' range:
.Range("R" & rowRes).Value = Join(arrT, ";") 'place the string in column R:R
.Range("A" & rowRes + 1 & ":A" & rowRes + count).Value = wsRef.Range("A" & i).Value 'copy the 'Codes'
.Range("B" & rowRes + 1 & ":B" & rowRes + count).Value = "Variant" 'write 'Variant'
.Range("N" & rowRes + 1).Resize(UBound(arr) + 1, 1).Value = WorksheetFunction.Transpose(arr) 'drop the array values
.Range("N" & rowRes).Formula = "=Sum(N" & rowRes + 1 & ":N" & rowRes + count & ")" 'sumarize the values of N:N col
'Evaluate the value in N:N and place 'TRUE' or 'FALSE' accordingly:
If .Range("N" & rowRes).Value = 0 Then .Range("K" & rowRes).Value = False Else: .Range("K" & rowRes).Value = True
End With
End If
rowRes = rowRes + count + 1: count = 0 'reinitialize the necessary variables
Next i
End Sub
If big files/ranges are involved, I can prepare a faster solution using arrays instead of all ranges.
Edited
I found some time and prepared the faster version, using only arrays, all processing being done in memory:
Sub testProcessThreeWorkbooksArrays()
Dim wsRef As Worksheet, wsData As Worksheet, wsRes As Worksheet
Dim lastRR As Long, lastRD As Long, rowRes As Long, i As Long, j As Long
Dim count As Long, k As Long, arrRef, arrDat, arrRes, arrSlice, arr, arrT
Dim m As Long, sumV As Double
Set wsRef = Workbooks("Example_Reference.xlsx").Sheets(1) 'use here the necessary sheet
Set wsData = Workbooks("Example_Data.xlsx").Sheets(1) 'use here the necessary sheet
Set wsRes = Workbooks("Example_Result.xlsx").Sheets(1) 'use here the necessary sheet
lastRR = wsRef.Range("A" & rows.count).End(xlUp).row 'last row of 'Reference` sheet
lastRD = wsData.Range("A" & rows.count).End(xlUp).row 'last row of 'Data' sheet
arrRef = wsRef.Range("A1:Q" & lastRR).Value
arrDat = wsData.Range("A1:C" & lastRD).Value
ReDim arrRes(1 To 18, 1 To UBound(arrRef) + UBound(arrDat))
rowRes = 1 'Row of the 'Result' sheet, where the new processed line should be placed
For i = 1 To UBound(arrRef) 'iterate between all existing 'arrRef' array rows
arrSlice = Application.Index(arrRef, i, 0) 'extract a slice of the row number i
'Place the slice values in the arrRes appropriate row:
For m = 1 To UBound(arrSlice): arrRes(m, rowRes) = arrSlice(m): Next m
arrSlice = Application.Index(arrDat, 0, 1) 'extract a slice of the 'arrDat' first column
For m = 1 To UBound(arrSlice)
If arrSlice(m, 1) = arrRef(i, 1) Then count = count + 1 'extract number of occurrences
Next m
If count > 0 Then 'if any occurence exists:
ReDim arrT(count - 1) 'redim the array keeping 'T' type data
ReDim arr(count - 1) 'redim the array to keep the values from C:C column
k = 0 'initialize the variable to fill in the above arrays
For j = 1 To UBound(arrDat) 'iterate between all 'arrDat' array rows:
If arrRef(i, 1) = arrDat(j, 1) Then 'in case of occurrences:
arrT(k) = arrDat(j, 2) 'load 'T' type values
arr(k) = arrDat(j, 3): k = k + 1 'Load values of C:C column
End If
Next j
arrRes(18, rowRes) = Join(arrT, ";") 'place the string in column R:R
For m = rowRes + 1 To rowRes + count
'place the code ("A:A" content) and "Variant" string:
arrRes(1, m) = arrRef(i, 1): arrRes(2, m) = "Variant"
Next m
For m = 0 To UBound(arr) 'place the values in the 14th column
arrRes(14, rowRes + m + 1) = arr(m)
sumV = sumV + arr(m) 'calculate the values Sum
Next m
arrRes(14, rowRes) = sumV 'place the Sum in the 14th array column
If sumV > 0 Then arrRes(11, rowRes) = True Else: arrRes(11, rowRes) = False 'True/False
End If
rowRes = rowRes + count + 1: count = 0: sumV = 0 'reinitialize the necessary variables
Next i
ReDim Preserve arrRes(1 To 18, 1 To rowRes - 1) 'keep only the non empty array elements
wsRes.Range("A1").Resize(UBound(arrRes, 2), UBound(arrRes)).Value = Application.Transpose(arrRes)
MsgBox "Ready..."
End Sub
Please, test it and send some feedback.
Edited: lol you changed your question.. ;)
If you like make everything with "Select" then:
Sub Macro1()
Set ref = Workbooks("book1").Sheets("sheet1")
Set res = Workbooks("book2").Sheets("sheet2")
ref.Rows("6:6").Copy
res.Activate
res.Rows("9:9").Select
ActiveSheet.Paste
End Sub
But you should avoid using select if you will have a lot of data, as its perfomance is slow as hell.
I am very new to coding with it, and what appears below probably looks quite horrible.
What this code currently does is do an instr search for all 3 required values appearing in a single, and absolutely defined (for test purposes), row of another table, in a separate worksheet. Copies the A cell value from that row, pastes it into the cell next to the source table row, currently being searched, and colour codes it with a green fill.
What I want it to do, is be aware that there is a whole other table of data in the other worksheet, and have it search row by row for all 3 required values matching in a given row.
Once it gets an exact hit, I want it to output the A cell value for the row that has been confirmed to be a match of all 3 required values.
The table in the other sheet is dynamic, in that it increases or decreases in total number of rows day be day.
Is anyone kind enough to be able to help me with this?
Now, here is my novice mishmash of code:
Private Sub Match_Click()
Dim i As Integer, row As Integer, narrative1 As String, transDate As Date,
amount As Double, result As String
row = 2
i = 1
narrative1 = Worksheets("Sheet2").Range("D" & row)
transDate = Worksheets("Sheet2").Range("B" & row)
amount = Worksheets("Sheet2").Range("J" & row)
Do While Cells(i, 1).Value <> ""
If narrative1 > "" Then
If InStr(1, UCase(Worksheets("Sheet1").Range("D22")), UCase(narrative1)) And
InStr(1, Worksheets("Sheet1").Range("B22"), transDate) And InStr(1,
Worksheets("Sheet1").Range("H22"), amount) Then
result = Worksheets("Sheet1").Range("A3").Value
Else
result = ""
End If
End If
i = i + 1
If Worksheets("Sheet2").Range("A" & row).Value = "" Then result = ""
Worksheets("Sheet2").Range("K" & row).Value = result
If result <> "" Then Worksheets("Sheet2").Range("K" & row).Interior.Color =
RGB(198, 224, 180)
If Worksheets("Sheet2").Range("A" & row).Value = "" Then
Worksheets("Sheet2").Range("K" & row).Interior.ColorIndex = xlNone
row = row + 1
narrative1 = Worksheets("Sheet2").Range("D" & row)
transDate = Worksheets("Sheet2").Range("B" & row)
amount = Worksheets("Sheet2").Range("J" & row)
Loop
End Sub
I think the following code will do what you expect, I've commented it to let you know what its doing (I haven't tested it, but I'm pretty sure it will do the job):
Private Sub Match_Click()
Dim i As Long 'These should be Long instead of Integer, as Excel has more cells than Integer has values.
Dim row As Long
Dim LastRow As Long
Dim LastRow2 As Long
Dim narrative1 As String
Dim transDate As String
Dim amount As Double
Dim result As String
Dim val1 As Integer
Dim val2 As Integer
Dim val3 As Integer
LastRow2 = Worksheets("Sheet2").Cells(Worksheets("Sheet2").Rows.Count, "A").End(xlUp).row 'get the lastrow of Sheet2
LastRow = Worksheets("Sheet1").Cells(Worksheets("Sheet1").Rows.Count, "A").End(xlUp).row 'get the lastrow of Sheet1
For i = 1 To LastRow2 'loop from row 1 to last on Sheet2
narrative1 = Worksheets("Sheet2").Range("D" & i) 'get the variables to compare
transDate = Worksheets("Sheet2").Range("B" & i)
amount = Worksheets("Sheet2").Range("J" & i)
For x = 1 To LastRow ' loop through row 1 to last on Sheet1
If narrative1 <> "" Then
val1 = InStr(Worksheets("Sheet1").Cells(x, 4).Value, narrative1) 'number 4 represents column D
val2 = InStr(Worksheets("Sheet1").Cells(x, 2).Value, transDate) 'number 2 represents column B
val3 = InStr(Worksheets("Sheet1").Cells(x, 8).Value, amount) 'number 8 represents column H
If val1 > 0 And val2 > 0 And val3 > 0 Then 'if all three have been found
result = Worksheets("Sheet1").Cells(x, 1).Value 'get result
Worksheets("Sheet2").Range("K" & LastRow2 + 1).Value = result 'paster result into next free row on Sheet2 column K
If Worksheets("Sheet2").Cells(x, 1).Value <> "" Then Worksheets("Sheet2").Range("K" & LastRow2 + 1).Interior.ColorIndex = 4
Else
result = ""
End If
End If
Next x
Next i
End Sub
first time poster, long time reader.
Apologies if this is hard to follow.
I have a spreadsheet which has a list of first names and last names. What I am wanting to do is take all of the first names which have the same last name and place them, evenly(ish) and separated by a comma, into the 3 reference columns in the same spreadsheet for example;
Example of Completed Sheet
I would like to do this in VBA because there are 200+ names and growing, and later the code will use this information to create and populate more workbooks.
So far, what I have works for all last names which have 3 or less first names (ie; one per column) but I cannot get it to work for last names where there are more than 3 first names.
My thought was to read all of the names into an array, split out the elements which have more than 3 names into another array, join these together separated by a comma, to then be transferred to the relevant column on the sheet.
However for some reason, I cannot get it to output more than one name into the column.
I have had a few attempts at this, but this is my latest attempt;
Private Sub cmdUpdate_Click()
Dim i As Long
Dim j As Long
Dim k As Long
Dim l As Long
Dim m As Long
Dim namesPerCol As Long
Dim strLastNameMatches As String
Dim arrNames() As String
Dim arrMultiNames(3) As String
Application.ScreenUpdating = False
With ActiveSheet
'Finds the last row with data in it
lngLastRow = .Cells(.Rows.count, "A").End(xlUp).Row
End With
'Sort the Columns
Columns("A:E").Sort key1:=Range("A1"), Header:=xlYes
'Loop through the LastNames
For i = 2 To lngLastRow
'Second loop through the LastNames
For j = 2 To lngLastRow
'If the last name matches
If Cells(i, 2).Value = Cells(j, 2).Value Then
'If the cell is empty then
If Range("C" & i).Value = "" Then
'Place the name in colA into colC
Range("C" & i).Value = Range("A" & j).Value
Else
'If the cell is not empty, then place a comma and space and then the value from colA
Range("C" & i).Value = Range("C" & i).Value & ", " & Range("A" & j).Value
End If
End If
Next j
Next i
For i = 2 To lngLastRow
strLastNameMatches = Range("C" & i).Value
arrNames = Split(strLastNameMatches, ", ")
If UBound(arrNames) > 2 Then
namesPerCol = UBound(arrNames) / 3
For l = 0 To 1
For k = LBound(arrNames) To namesPerCol
arrMultiNames(l) = arrNames(k) & ", "
Next k
Next l
For m = LBound(arrMultiNames) To UBound(arrMultiNames)
Select Case m
Case 0
Range("C" & i).Value = arrMultiNames(m)
Case 1
Range("D" & i).Value = arrMultiNames(m)
Case 2
Range("E" & i).Value = arrMultiNames(m)
End Select
Next m
Else
For j = LBound(arrNames) To UBound(arrNames)
Select Case j
Case 0
Range("C" & i).Value = arrNames(j)
Case 1
Range("D" & i).Value = arrNames(j)
Case 2
Range("I" & i).Value = arrNames(j)
End Select
Next j
End If
Next i
Application.ScreenUpdating = True
End Sub
Apologies for the poor quality coding, I will work on tiding it up once it is all working.
Any help I can get to get this code splitting out the names evenly across the three columns will be greatly appreciated
This task might be simpler if you could store your data into a more tree-like structure. There are many ways to do this; I've used the Collection object as it's easy to handle an unknown number of items. Basically, there are collections within a collection, ie one collection of first names for each last name.
The sample below uses very rudimentary distribution code (which is also hard-coded to a split of 3), but the point is that iterating through and down the tree is far simpler:
Dim lastList As Collection, firstList As Collection
Dim lastText As String, firstText As String
Dim data As Variant, last As Variant, first As Variant
Dim output() As Variant, dist(1 To 3) As Long
Dim str As String
Dim r As Long, c As Long, i As Long
'Read data into an array
With Sheet1
data = .Range(.Range("A1"), .Cells(.Rows.Count, "B").End(xlUp)).Value2
End With
'Create lists of unique lastnames containing the firstnames
Set lastList = New Collection
For r = 2 To UBound(data, 1)
firstText = CStr(data(r, 1))
lastText = CStr(data(r, 2))
Set firstList = Nothing
On Error Resume Next
Set firstList = lastList(lastText)
On Error GoTo 0
If firstList Is Nothing Then
Set firstList = New Collection
lastList.Add firstList, lastText
End If
firstList.Add firstText
Next
'Write results to sheet
ReDim output(1 To UBound(data, 1) - 1, 1 To 3)
For r = 2 To UBound(data, 1)
lastText = CStr(data(r, 2))
Set firstList = lastList(lastText)
'Calculate the distribution
dist(3) = firstList.Count / 3 'thanks #Comitern
dist(2) = dist(3)
dist(1) = firstList.Count - dist(2) - dist(3)
i = 1: c = 1: str = ""
For Each first In firstList
str = str & IIf(i > 1, ", ", "") & first
i = i + 1
If i > dist(c) Then
output(r - 1, c) = str
i = 1: c = c + 1: str = ""
End If
Next
Next
Sheet1.Range("C2").Resize(UBound(output, 1), UBound(output, 2)).Value = output
Following is part of my program which does the follwoing function
It will look into column K and column L and create tabs according to the combinations. For example if column K has a cell value "Apple" and column L has one cell value "Orange" it will create a tab 1) Apple - Orange
The new tab will have all the rows with this combination
So once complete the running of macro , the whole data will get divided to different tabs according to the K - L combination
My problem is it is giving a run time error when entire column K or entire column L has only one value. For example if entire K column has 10 rows and all column k cells has value Apple it will give error. same goes for column L.
Dim m As Integer
Dim area As Range
Count = Range("K:K").SpecialCells(xlLastCell).Row
ActiveSheet.Range("K2:K" & Count).AdvancedFilter Action:=xlFilterCopy,
CopyToRange:=ActiveSheet.Range("Z2"), Unique:=True
Columns(26).RemoveDuplicates Columns:=Array(1)
Count1 = Range("L:L").SpecialCells(xlLastCell).Row
ActiveSheet.Range("L2:L" & Count1).AdvancedFilter Action:=xlFilterCopy,
CopyToRange:=ActiveSheet.Range("Y2"), Unique:=True
Columns(25).RemoveDuplicates Columns:=Array(1)
Dim arrayv As String
Dim Text1 As String
Dim arrayv1 As String
last = Range("Z2").End(xlDown).Row
arrayv = WorksheetFunction.Transpose(Sheets(1).Range("Z2:Z" & last).Value)
last1 = Range("Y2").End(xlDown).Row
arrayv1 = WorksheetFunction.Transpose(Sheets(1).Range("Y2:Y" & last1).Value)
Columns(26).EntireColumn.Delete
Columns(25).EntireColumn.Delete
Dim i As Long, j As Long
Dim flag As Variant
flag = 1
A = 1
s = 2
For c = 1 To UBound(arrayv1)
For t = 1 To UBound(arrayv)
Sheets.Add().Name = "Sheet" & s
ActiveSheet.Move After:=Sheets(ActiveWorkbook.Sheets.Count)
With Worksheets("Sheet1")
j = 2
.Rows(1).Copy Destination:=Worksheets("Sheet" & s).Range("A" & 1)
flag = 1
For i = 2 To Count
If .Cells(i, 11).Value = arrayv(t) Then
If .Cells(i, 12).Value = arrayv1(c) Then
Text = .Cells(i, 15).Value
flag = 0
.Rows(i).Copy Destination:=Worksheets("Sheet" & s).Range("A" & j)
j = j + 1
End If
End If
Next i
If flag = 1 Then
Sheets("Sheet" & s).Delete
Else
Text1 = Left(Text, 4)
Error line when column K has only one value
arrayv = WorksheetFunction.Transpose(Sheets(1).Range("Z2:Z" & last).Value)
Error line when column L has only one value
arrayv1 = WorksheetFunction.Transpose(Sheets(1).Range("Y2:Y" & last1).Value)
If there is only one value Y2 or Z2 downwards then using the Range,End property with an xlDirection of xlDown is going to reference row 1,048,576. The WorksheetFunction.Transpose method has a limit of 65,536. Anything exceeding this limit will result in,
Run-time error '13':Type mismatch.
Change the direction of the last-row-seek to look up from the bottom with xlUp.
last = Range("Z" & rows.count).End(xlUp).Row
arrayv = WorksheetFunction.Transpose(Sheets(1).Range("Z2:Z" & last).Value)
last1 = Range("Y" & rows.count).End(xlUp).Row
arrayv1 = WorksheetFunction.Transpose(Sheets(1).Range("Y2:Y" & last1).Value)
New to this so bear with me.
I want to automatically insert a certain number or rows based on a value in another column. Can this be done?
eg
Container Lifts
B0237 1
B0238 7
B0239 7
A8783 2
So the containers would be split by the number of lifts
One for loop nested in a while loop should do your job. Why we are suing while instead of for because we can not dynamically change the limit of For loop when we add a new row in between existing data. So there you go:
Dim LastRow As Long
Dim RowAddNo As Long
LastRow = Range("A1").End(xlDown).Row
i = 2
While i <= LastRow
RowAddNo = Range("B" & i).Value
For J = 1 To RowAddNo
Rows(i + 1 & ":" & i + 1).Insert shift:=xlUp
LastRow = LastRow + 1
i = i + 1 'increasing the 'i' value to find the address for the next not empty row
Next
i = i + 1 'increasing the 'i' value to find the address for the next not empty row
Wend
PS: Do not try without i = i + 1. it goes in an endless loop :)
This will do it for you:
Sub AddRows()
Dim X As Long
For X = Range("A" & Rows.Count).End(xlUp).Row To 2 Step -1 'Work backwards when inserting or deleting rows, so much easier than incrementing numbers
Range("A" & X).Offset(1, 0).Resize(Range("B" & X).Value, 1).EntireRow.Insert 'Insert the number of rows against the target row offset by 1 ie below it
Next
End Sub