I have an Excel workbook with two tabs. The first tab is titled "StagingArea" (table name on sheet is _StagingArea) which has data grouped by module. What I'm trying to do is dynamically move data from the table in the "StagingArea" sheet (_StagingArea) to the table in the "Module1" sheet (_Module1). So, if a new row gets added for module 'Module1' in "StagingArea" I need that to then be moved to "Module1" sheet. So far, I have the following code:
Private Sub Workbook_Open()
Dim i, LastRow
LastRow = Sheets("Staging Area").Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To LastRow
If Sheets("Staging Area").Cells(i, "A").Value = "Module1" Then
Sheets("Staging Area").Cells(i, "A").EntireRow.Copy Destination:=Sheets("Module1").Range("_Module1").End(xlUp).Offset(1)
End If
Next i
End Sub
The problem I'm running into is that it is looping through the rows for "Module1" but only inserting the last row into the table on sheet "Module1."
I also need to then delete the rows from "StagingArea" sheet that were copied/moved over to the "Module1" sheet. Thanks for any help you can provide!
Move operation is achieved by Copy followed by Delete. There is no inbuilt move functionality in VBA to achieve this. Hence, I have modified your code a little. Hope, it helps.
Private Sub Workbook_Open()
Dim i as Long, LastRow as Long
Dim rng as Range
LastRow = Sheets("Staging Area").Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To LastRow
If Sheets("Staging Area").Cells(i, "A").Value = "Module1" Then
Sheets("Staging Area").Cells(i, "A").EntireRow.Copy Destination:=Sheets("Module1").Range("_Module1").End(xlDown).Offset(1, 0)
If rng Is Nothing Then
Set rng = Sheets("Staging Area").Cells(i, "A")
Else
Set rng = Union(rng, Sheets("Staging Area").Cells(i, "A"))
End If
End If
Next i
If Not rng Is Nothing Then
rng.EntireRow.Delete
End If
End Sub
Related
I want to copy unique values over to my destination worksheet but I'm getting an error with my Range. Originally I wrote a RemoveDuplicates code with exact same Range values and it worked perfectly fine. I'm assuming the issue is in my AdvancedFilter line but I can't figure out what's wrong with it.
Edit;
I qualified my ranges and that fixed the issue(updated code). Now I realize that I need at least 2 source rows to filter from. I'm thinking I ditch using AdvancedFilter and try a different approach. Is there a way for me to use the Unique parameter or something similar without AdvancedFilter?
Private Sub moveData()
Dim wb As Workbook
Dim wksData As Worksheet
Dim wksDestination As Worksheet
Dim lastColumn As Integer
Dim lastRow As Integer
Dim destinationRow As Integer
Set wksData = Worksheets("ProspectiveCandidates")
Set wksDestination = Worksheets("Active Candidate Information")
destinationRow = 2
lastColumn = wksData.Range("B" & Columns.Count).End(xlToLeft).Column
lastRow = wksData.Range("B" & Rows.Count).End(xlUp).Row
For i = lastRow To 1 Step -1 'go 'up' the worksheet
If wksData.Cells(i, 8).Value = "Move Forward" Then 'check for Move Forward Value in the current row
'if TRUE, copy row to wksDestination and filter for Unique
wksData.Range(wksData.Cells(i, 2), wksData.Cells(i, 5)).AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=wksDestination.Range(wksDestination.Cells(destinationRow, 2), wksDestination.Cells(destinationRow, 5)), _
Unique:=True
'increment the output row
destinationRow = destinationRow + 1
End If
Next i
End Sub
Edit2;
I updated my For loop and took out AdvancedFilter. I'm having trouble skipping over duplicates and pasting copied values once no duplicates have been detected.
For i = lastRow To 1 Step -1 'go 'up' the worksheet
If wksData.Cells(i, 8).Value = "Move Forward" Then 'check for Move Forward Value in the current row
'if TRUE, copy cells column 2-5 in row i
wksData.Activate
wksData.Range(Cells(i, 2), Cells(i, 5)).Copy
'check for duplicates on wksDestination
For Each xlCell In xlRange
If xlCell.Value = wksData.Cells(i, 2) Then Exit For
Next xlCell
'if no duplicates detected then paste values
wksDestination.Activate
wksDestination.Range(Cells(destinationRow, 2), Cells(destinationRow, 5)).Select
ActiveSheet.Paste
'increment the output row
destinationRow = destinationRow + 1
End If
Next i
Edit3
Here is a partial screenshot of my sheet with the source data:
ProspectiveCandidates
When the status is updated to "Move Forward", I want just the "Candidate Name", "Source", "Team", and "Level" to be copied over to my second sheet("Active Candidate Information").
For this to run automatically, in the sheet code I have
Private Sub Worksheet_Change(ByVal Target As Range)
Application.Run "Module3.moveData"
End Sub
I want to make sure that anytime new values are copied over that they go to the next empty row. I was having issues with an earlier code that would rewrite and mess up the order of my data.
I have the sheet like this:
Picture given
All I want to is that, I can move down the next row and show its value.
I already have the code:
Sub test()
'Select the first row.
MsgBox Sheet1.AutoFilter.Range.Offset(1).SpecialCells(xlCellTypeVisible).Cells(1, 3).Value
'Then move down to the second row of filtered data.
'Code
End Sub
Can someone suggest how to finish my sub above?
I would appreciate your help.
You could try implement/adapt the following:
Sub VisRows()
Dim rng As Range, lr As Long
With Sheet1 'Change accordingly
lr = .Cells(.Rows.Count, "B").End(xlUp).Row
Set rng = .Range("B2:B" & lr)
'Apply your filter
For Each cl In rng.SpecialCells(xlCellTypeVisible)
Debug.Print cl.Value
Next cl
End With
End Sub
Dears,
I am a beginner and tried to prepare the macro that enables firstly delete rows based on condition, than create new sheets based on criteria from the first main sheet and add data from the first main sheet into multiple named sheets.
deletes rows based on condition (RUNs OK)
creates new sheets based on criteria from the first main sheet (RUNs OK)
adds data from the first main sheet (constant range I4:I6)
into multiple named sheets to A1:A3 in all of them (being created by this macro). Unfortunately I do not know how to do that :-(
Could you possibly help me, please?
Private Sub CommandButton1_Click()
Dim lastrow As Long, x As Long
lastrow = Cells(Rows.Count, "A").End(xlUp).Row
For x = lastrow To 1 Step -1
If UCase(Cells(x, 3).Value) = "0" And _
UCase(Cells(x, 6).Value) = "0" Then
Rows(x).Delete
End If
Next
lastcell = ThisWorkbook.Worksheets("Obratova predvaha").Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To lastcell
With ThisWorkbook
newname = ThisWorkbook.Worksheets("Obratova predvaha").Cells(i, 1).Value
.Sheets.Add after:=.Sheets(.Sheets.Count)
ActiveSheet.Name = newname
End With
Next
ThisWorkbook.Worksheets("Obratova predvaha").Activate
ThisWorkbook.Worksheets("Obratova predvaha").Cells(1, 1).Select
End Sub
not very sure about your description, but you may try this:
edited to add a sheet variable and prevent any (possible?) time lapse misbehavior between new sheet adding and writing to it by implicitly assuming it as ActiveSheet:
Option Explicit
Private Sub CommandButton1_Click()
Dim lastrow As Long, i As Long
Dim newSheet As Worksheet
With Worksheets("Obratova predvaha")
lastrow = .Cells(.Rows.Count, 1).End(xlUp).Row
For i = lastrow To 1 Step -1
If UCase(.Cells(i, 3).Value) = "0" And UCase(.Cells(i, 6).Value) = "0" Then .Rows(i).Delete
Next
lastrow = .Cells(.Rows.Count, 1).End(xlUp).Row
For i = 2 To lastrow
Set newSheet = Sheets.Add(after:=Sheets(Sheets.Count)) ' add a new sheet and hold its reference in newSheet variable
newSheet.Range("A1:A3").Value = .Range("I4:I6").Value ' copy referenced sheet I4:I6 values into newly added sheet cells A1:A3
newSheet.Name = .Cells(i, 1).Value ' change the name of newly added sheet
Next
End With
End Sub
I have two worksheets in one Excel workbook, and I only want to take the lines that have data in the cell (from worksheet1 into worksheet2) if Column A has data in it. My formula in worksheet 2 is =IF('Raw Data'!A2<>"", 'Raw Data'!A2,), but I actually don't want it to bring in the row at all if there is no data as shown in Rows 3 and 5. Right now it is bringing the whole row in:
In
you see that it is still bringing the row into worksheet 2 if there is no data. Any ideas how to only bring in the rows with the data?
Sub DataInCell()
Dim rw As Long
rw = 2
' Select initial sheet to copy from
Sheets("Raw Data").Select
' Find the last row of data - xlUp will check from the bottom of the spreadsheet up.
FinalRow = Cells(Rows.Count, 1).End(xlUp).Row
' For loop through each row
For x = 2 To FinalRow
If Cells(x, 1).Value <> 0 Then
Range("A" & x & ":C" & x).Copy
Sheets("Sheet1").Select
NextRow = Cells(Rows.Count, 1).End(xlUp).Row + 1 'Continue incrementing through the rows.
Cells(NextRow, 1).Select ' Find the next row.
ActiveSheet.Cells(NextRow, "A").PasteSpecial xlPasteAll ' Paste information.
Sheets("Raw Data").Select 'Reselect sheet to copy from. Probably uneccessary.
End If
Next x
End Sub
After you update the sheet names on the 3rd and 4th line, you will see that the code carries over the entire row. You can modify using Range(Cells, Cells) if you want partial ranges.
Option Explicit
Sub Non_Blanks()
Dim ms As Worksheet: Set ms = ThisWorkbook.Sheets("Sheet1") '<-- Master Sheet
Dim ns As Worksheet: Set ns = ThisWorkbook.Sheets("Sheet2") '<-- New Sheet
Dim i As Long, MoveMe As Range, LR As Long
For i = 2 To ms.Range("B" & ms.Rows.Count).End(xlUp).Row
If ms.Range("A" & i) = "*" Then
If Not MoveMe Is Nothing Then
Set MoveMe = Union(MoveMe, ms.Range("A" & i))
Else
Set MoveMe = ms.Range("A" & i)
End If
End If
Next i
If Not MoveMe Is Nothing Then
LR = ns.Range("A" & ns.Rows.Count).End(xlUp).Offset(1).Row
MoveMe.EntireRow.Copy
ns.Range("A" & LR).PasteSpecial xlPasteValuesAndNumberFormats
End If
End Sub
I have a vba code that copies rows on a sheet to another sheet depending if column A = 1 and it works perfectly. I am trying to make it paste to the next available row instead of overwriting the data that is already there in order to make a log. Here is the code I have already but I can't seem to figure out how to make it paste to the next available row. Any help would be greatly appreciated! Thanks in advance!
Sub Log()
Dim rng As Range
Dim lastRow As Long
Dim cell As Variant
Dim count As Long
count = 0
With ActiveSheet
lastRow = .Range("A" & .Rows.count).End(xlUp).Row
Set rng = .Range("A3:A" & lastRow)
For Each cell In rng
If cell.Value = "1" Then
Range(cell.Offset(0, 1), cell.Offset(0, 6)).Copy
Range("'Log'!B3").Offset(count, 0).PasteSpecial xlPasteValues
count = count + 1
End If
Next
End With
End Sub
You just need to loop through the source sheet.
Try using .Cells(row,col) instead of Range..
This example is heavy on the comments to help understand the looping process.
You will need a few additional Functions to make this work using this code.
LastRow Function
Function lastRow(sheet As String) As Long
lastRow = Sheets(sheet).Cells(Rows.Count, "A").End(xlUp).Row 'Using Cells()
End Function
LastCol Function
Function lastCol(sheet As String) As Long
lastCol = Sheets(sheet).Cells(2, Columns.Count).End(xlToLeft).Column
End Function
Code for solution: Assuming you have your target sheet's headers already set up AND the target and source sheet share the same formatting.
Sub Log()
Dim source As String, target As String
Dim sRow As Long, col As Long, tRow As Long
'Declare Sheets
source = "Sheet1"
target = "Sheet2"
'Loop through rows of source sheet
For sRow = 2 To lastRow(source)
'Get current last row of Target Sheet
tRow = lastRow(target) + 1
'Meet criteria for Column A to = 1 on Source
If Sheets(source).Cells(sRow, 1) = "1" Then
'Copy each column of source sheet to target sheet in same order
For col = 1 To lastCol(source)
Sheets(target).Cells(tRow, col) = Sheets(source).Cells(sRow, col)
Next col
End If
Next sRow
End Sub