Hi can someone help please?
I have two worksheets and wish to copy rows from worksheet 1 to worksheet 2 if a condition is met in one of the cells within that row.
Hope that makes sense.
Thanks
Hi can someone help please?
I have two worksheets and wish to copy rows from worksheet 1 to worksheet 2 if a condition is met in one of the cells within that row.
Hope that makes sense.
Thanks
Re: If a cell meets a condition, copy that row to another worksheet
It is likely you have not gotten a reply because your post does not provide enough detail.
What are the conditions?
To get the most precise answers, it is best to upload a sample workbook (sensitive data scrubbed/removed) that shows a few manually created examples of the desired results.
The structure and data types of the workbook must exactly match that of the real workbook. Include in the workbook a clear and explicit explanation of all requirements.The sample workbook only needs to contain enough data to illustrate the need to aid with developing the solution.
[COLOR="navy"]How to edit your post or thread title or upload an attachment[/COLOR]
1. Click the EDIT POST in the gray band immediately below your post
2. Click Go Advanced
3. Edit the post or thread title
4. To upload: scroll down to Manage Attachments -- use ZIP compression if necessary to meet file size limitations
Re: If a cell meets a condition, copy that row to another worksheet
Hoping this explains a little better (attached an example workbook) and someone can help.
Hope this explains a bit better.
Many thanks for looking.
[ATTACH=CONFIG]40299[/ATTACH]
Re: If a cell meets a condition, copy that row to another worksheet
Hi stickyfeet,
Paste the following into the code of your UserForm1.
Instead of copying and pasting each row it stores the data in memory, makes decisions based on your criteria and creates another array that it will paste all at once into your report sheet. This is so that if you happen to have a significant amount of rows it still should run quite zippy.
Some things to keep in mind here are:
If I didn't make any sense at all or you have any questions, ask away.
Cheers,
MJ
Option Explicit
Private Sub CommandButton1_Click()
Dim lRow As Long, lCol As Long
Dim lInsertRow As Long
Dim oDetailSheet As Worksheet, oReportSheet As Worksheet
Dim lLocation As Long
Dim vData As Variant
Dim vReportData() As Variant
Set oDetailSheet = Sheet1 'Set to the detail sheet
Set oReportSheet = Sheet2 'Set to the report sheet
lLocation = Right(ComboBox1.Value, 1)
If LastRow(oDetailSheet) < 3 Then Unload Me: Exit Sub 'Unload and Exit if there are no rows in data
vData = oDetailSheet.Range(oDetailSheet.Cells(3, 1), oDetailSheet.Cells(3, 1).End(xlDown).End(xlToRight)).Value 'Store relevant data in array (Note: You might want to hardcode the fact that there are 4 columns)
If LastRow(oReportSheet) > 2 Then oReportSheet.Range(oReportSheet.Cells(3, 1), oReportSheet.Cells(3, 1).End(xlDown).End(xlToRight)).Clear 'Clear relevant area in Report sheet
lInsertRow = 0
For lRow = LBound(vData, 1) To UBound(vData, 1)
If vData(lRow, 1) = lLocation Then
lInsertRow = lInsertRow + 1
ReDim Preserve vReportData(1 To UBound(vData, 2), 1 To lInsertRow) 'Array is transposed as you can only alter the last dimension of an array while preserving
For lCol = LBound(vData, 2) To UBound(vData, 2)
vReportData(lCol, lInsertRow) = vData(lRow, lCol)
Next lCol
End If
Next lRow
TransposeArray2D vReportData
oReportSheet.Range(oReportSheet.Cells(3, 1), oReportSheet.Cells(3, 1)).Resize(UBound(vReportData, 1), UBound(vReportData, 2)).Value = vReportData
Unload Me
End Sub
Private Sub UserForm_Initialize()
With ComboBox1
.AddItem "Report All Location 1"
.AddItem "Report All Location 2"
.AddItem "Report All Location 3"
.AddItem "Report All Location 4"
End With
End Sub
Private Function LastRow(oWS As Worksheet)
LastRow = oWS.UsedRange.Rows.Count
Do Until WorksheetFunction.CountA(oWS.Rows(LastRow)) <> 0 Or LastRow = 1
oWS.Rows(LastRow).EntireRow.Delete
LastRow = oWS.UsedRange.Rows.Count
Loop
End Function
Private Sub TransposeArray2D(ByRef InputArr As Variant)
Dim lRow As Long, lCol As Long
Dim vTemp() As Variant
If Not IsArray(InputArr) Then Exit Sub
ReDim vTemp(LBound(InputArr, 2) To UBound(InputArr, 2), LBound(InputArr, 1) To UBound(InputArr, 1))
For lRow = LBound(vTemp, 1) To UBound(vTemp, 1)
For lCol = LBound(vTemp, 2) To UBound(vTemp, 2)
vTemp(lRow, lCol) = InputArr(lCol, lRow)
Next lCol
Next lRow
InputArr = vTemp
End Sub
Display More
Re: If a cell meets a condition, copy that row to another worksheet
Wow! Worked first time :smile: thank you very much, its much appreciated.
Regards
Re: If a cell meets a condition, copy that row to another worksheet
My pleasure,
Cheers,
MJ
Re: If a cell meets a condition, copy that row to another worksheet
This code is working perfectly, so much so that I'm trying to apply it to another workbook.
I'm trying to work through it to try and determine what is going on, but I'm not getting very far.
So I'm going to be cheeky and ask for a little more help please.
Rather than looking at the first column, I'm trying to get the code to look at another column. Then do exactly the same thing by copying the whole line.
I've been looking at 'lLocation' as this is where it gets the value from the combobox, then trying to work out how/where it determines which column to look at.
Can you help please?
Thanks
Re: If a cell meets a condition, copy that row to another worksheet
Hi stickyfeet,
So I've altered the code a bit to make it a little more general and customizable. Firstly to answer your question:
Quote
I've been looking at 'lLocation' as this is where it gets the value from the combobox, then trying to work out how/where it determines which column to look at.
The code was choosing which column to look at on this line:
The '1' means it's checking against the first column in vData which is the array created from the data range. Also, lLocation was getting its value from the rightmost character of your combobox because of how the values were hardcoded in, this isn't really necessary as you'll see in the updated code.
So, I changed the code so that it lets you choose which column you would like to filter on and then dynamically updates the combobox with a unique and somewhat sorted (works kind of odd on text) list of values from that column. The subroutines to create the unique list and sort it are at the bottom (some of my favourites).
I also changed two more things:
So here's a copy of the code to look at but I changed your Userform a bit to allow for my changes so I'll also include the .frm and .frx files so you can just import it into your spreadsheet. If you have any questions, feel free to ask.
Cheers,
MJ
[ATTACH=CONFIG]40333[/ATTACH]
Option Explicit
Dim lColumn As Long
Private Sub cmdCreate_Click()
Dim lRow As Long, lCol As Long
Dim lInsertRow As Long
Dim oDetailSheet As Worksheet, oReportSheet As Worksheet
Dim vTestValue As Variant
Dim vData As Variant
Dim vReportData() As Variant
Set oDetailSheet = Sheet1 'Set to the detail sheet
Set oReportSheet = Sheet2 'Set to the report sheet
vTestValue = cmbReportType.Value
If LastRow(oDetailSheet) < 3 Then Unload Me: Exit Sub 'Unload and Exit if there are no rows in data
vData = oDetailSheet.Range(oDetailSheet.Cells(3, 1), oDetailSheet.Cells(3, 1).End(xlDown).End(xlToRight)).Value 'Store relevant data in array (Note: You might want to hardcode the fact that there are 4 columns)
If LastRow(oReportSheet) > 2 Then oReportSheet.Range(oReportSheet.Cells(3, 1), oReportSheet.Cells(3, 1).End(xlDown).End(xlToRight)).EntireRow.Delete 'Clear relevant area in Report sheet
lInsertRow = 0
For lRow = LBound(vData, 1) To UBound(vData, 1)
If CStr(vData(lRow, lColumn)) = CStr(vTestValue) Then
lInsertRow = lInsertRow + 1
ReDim Preserve vReportData(1 To UBound(vData, 2), 1 To lInsertRow) 'Array is transposed as you can only alter the last dimension of an array while preserving
For lCol = LBound(vData, 2) To UBound(vData, 2)
vReportData(lCol, lInsertRow) = vData(lRow, lCol)
Next lCol
End If
Next lRow
TransposeArray2D vReportData
oReportSheet.Range(oReportSheet.Cells(3, 1), oReportSheet.Cells(3, 1)).Resize(UBound(vReportData, 1), UBound(vReportData, 2)).Value = vReportData
Unload Me
End Sub
Private Sub UserForm_Initialize()
Dim oDetailSheet As Worksheet
Dim vColNames() As Variant
Set oDetailSheet = Sheet1
vColNames = oDetailSheet.Range(oDetailSheet.Cells(2, 1), oDetailSheet.Cells(2, 1).End(xlToRight)).Value
TransposeArray2D vColNames
cmbTestCol.List = vColNames
End Sub
Private Sub cmbTestCol_Change()
Dim oDetailSheet As Worksheet
Dim vReportTypes() As Variant
Set oDetailSheet = Sheet1
lColumn = cmbTestCol.ListIndex + 1
vReportTypes = UniqueItems(oDetailSheet.Range(oDetailSheet.Cells(3, lColumn), oDetailSheet.Cells(2, lColumn).End(xlDown)).Value, True)
cmbReportType.List = vReportTypes
End Sub
Private Function LastRow(oWS As Worksheet)
LastRow = oWS.UsedRange.Rows.Count
Do Until WorksheetFunction.CountA(oWS.Rows(LastRow)) <> 0 Or LastRow = 1
oWS.Rows(LastRow).EntireRow.Delete
LastRow = oWS.UsedRange.Rows.Count
Loop
End Function
Private Sub TransposeArray2D(ByRef InputArr As Variant)
Dim lRow As Long, lCol As Long
Dim vTemp() As Variant
If Not IsArray(InputArr) Then Exit Sub
ReDim vTemp(LBound(InputArr, 2) To UBound(InputArr, 2), LBound(InputArr, 1) To UBound(InputArr, 1))
For lRow = LBound(vTemp, 1) To UBound(vTemp, 1)
For lCol = LBound(vTemp, 2) To UBound(vTemp, 2)
vTemp(lRow, lCol) = InputArr(lCol, lRow)
Next lCol
Next lRow
InputArr = vTemp
End Sub
Private Function UniqueItems(ByRef ArrayIn, Optional ByVal Sort As Boolean = True) As Variant
' Accepts an array or range as input
Dim Unique() As Variant ' array that holds the unique items
Dim Element As Variant
Dim i As Long
Dim FoundMatch As Boolean
Dim NumUnique As Long
' Loop thru the input array
For Each Element In ArrayIn
FoundMatch = False
' Has item been added yet?
For i = 1 To NumUnique
If Element = Unique(i) Then
FoundMatch = True
Exit For '(exit loop)
End If
Next i
' If not in list, add the item to unique list
If Not FoundMatch Then
NumUnique = NumUnique + 1
ReDim Preserve Unique(1 To NumUnique)
Unique(NumUnique) = Element
End If
Next Element
' Assign a value to the function
If Sort = True Then QuickSort Unique
For i = 1 To NumUnique
If IsEmpty(Unique(i)) Then Unique(i) = "#Empty#"
Next i
UniqueItems = Unique
End Function
Private Sub QuickSort(ByRef lngArray() As Variant, Optional ByRef swapArray As Variant)
Dim iLBound As Long
Dim iUBound As Long
Dim iTemp As Variant, iTemp2 As Variant
Dim iOuter As Long
Dim iMax As Long
iLBound = LBound(lngArray)
iUBound = UBound(lngArray)
If Not IsMissing(swapArray) Then If LBound(swapArray) <> iLBound Or UBound(swapArray) <> iUBound Then Err.Raise 9
'Dont want to sort array with only 1 value
If (iUBound - iLBound) Then
'Move the largest value to the rightmost position, otherwise
'we need to check that iLeftCur does not exceed the bounds of the
'array on EVERY pass (time consuming)
iMax = 1
For iOuter = iLBound To iUBound
If lngArray(iOuter) > lngArray(iMax) Then iMax = iOuter
Next iOuter
iTemp = lngArray(iMax)
If Not IsMissing(swapArray) Then iTemp2 = swapArray(iMax)
lngArray(iMax) = lngArray(iUBound)
If Not IsMissing(swapArray) Then swapArray(iMax) = swapArray(iUBound)
lngArray(iUBound) = iTemp
If Not IsMissing(swapArray) Then swapArray(iUBound) = iTemp2
'Start quicksorting
If Not IsMissing(swapArray) Then
InnerQuickSort lngArray, iLBound, iUBound, swapArray
Else
InnerQuickSort lngArray, iLBound, iUBound
End If
End If
End Sub
Private Sub InnerQuickSort(ByRef lngArray() As Variant, ByVal iLeftEnd As Long, ByVal iRightEnd As Long, Optional ByRef swapArray As Variant)
Dim iLeftCur As Long
Dim iRightCur As Long
Dim iPivot As Variant, iPivot2 As Variant
Dim iTemp As Variant, iTemp2 As Variant
If iLeftEnd >= iRightEnd Then Exit Sub
iLeftCur = iLeftEnd
iRightCur = iRightEnd + 1
iPivot = lngArray(iLeftEnd)
If Not IsMissing(swapArray) Then iPivot2 = swapArray(iLeftEnd)
'Arrange values so that < pivot are on the left and > pivot are on the right
Do
'Find >= value on left side
Do
iLeftCur = iLeftCur + 1
Loop While lngArray(iLeftCur) < iPivot
'Find <= value on right side
Do
iRightCur = iRightCur - 1
Loop While lngArray(iRightCur) > iPivot
'No more swapping to do
If iLeftCur >= iRightCur Then Exit Do
'Swap
iTemp = lngArray(iLeftCur)
If Not IsMissing(swapArray) Then iTemp2 = swapArray(iLeftCur)
lngArray(iLeftCur) = lngArray(iRightCur)
If Not IsMissing(swapArray) Then swapArray(iLeftCur) = swapArray(iRightCur)
lngArray(iRightCur) = iTemp
If Not IsMissing(swapArray) Then swapArray(iRightCur) = iTemp2
Loop
'Call quicksort recursively on left and right subarrays
lngArray(iLeftEnd) = lngArray(iRightCur)
If Not IsMissing(swapArray) Then swapArray(iLeftEnd) = swapArray(iRightCur)
lngArray(iRightCur) = iPivot
If Not IsMissing(swapArray) Then swapArray(iRightCur) = iPivot2
If Not IsMissing(swapArray) Then
InnerQuickSort lngArray, iLeftEnd, iRightCur - 1, swapArray
InnerQuickSort lngArray, iRightCur + 1, iRightEnd, swapArray
Else
InnerQuickSort lngArray, iLeftEnd, iRightCur - 1
InnerQuickSort lngArray, iRightCur + 1, iRightEnd
End If
End Sub
Display More
Re: If a cell meets a condition, copy that row to another worksheet
Hi and thanks again. Works perfectly! Also been spending a bit of time going through the code and trying to work out what's going on.
I've reused the code several times in different workbooks/projects. So once again a big thanks for your time.
Regards
Re: If a cell meets a condition, copy that row to another worksheet
It's my pleasure, I'm glad you're finding it useful and learning from it. If you have any questions as you go through the code, feel free to ask.
Cheers,
MJ
Re: If a cell meets a condition, copy that row to another worksheet
Hi, hoping LeastAction is around.
I'm trying to do something similar to the above by reusing your code. I'm stuggling with it so was hoping you can help again.
Same kind of worksheet but there is a number in Column 'S' and when that number is met (users selects) then I need that row copied across to a new worksheet.
I kind of (well I think) I understand bits of the code but getting it to look in 'S' just doesnt seem to work.
Big thanks!
Re: If a cell meets a condition, copy that row to another worksheet
how to do the same thing with using user form in excel. i dont want to use combo box.
Re: If a cell meets a condition, copy that row to another worksheet
Please do not post questions in threads started by other members.
If you have a query then start your own thread, give it an accurate and concise title that summarises your problem and explain your issue fully.
If your question relates to this (or any other) thread, then include a link by copying the URL from the address bar of your browser and pasting into your message.
Make sure you explain exactly the changes needed and how you would see them working. The code in this thread relates to selections from a combobox but you "dont want to use combo box" - please explain the process you have in mind.
Don’t have an account yet? Register yourself now and be a part of our community!