PDA

View Full Version : [SOLVED] Compare/Copy new location. Isn't working!



akj375
12-12-2010, 06:53 PM
I’m new to VBA and basically trying to teach myself. I’ve worked through a beginners book, and I’m having a great deal of trouble setting up a procedure that will do the following:

I want to create a new worksheet (PasteSheet 1). Then compare the contents of the cells in column “I” of sheet1, say starting at “I4” to those in column “G4”. Whenever a match is found between cells, copy the contents of cells in the same row of adjacent columns, like cells “A4”, “B4”,“C4” and “G4” and paste these values into “PasteSheet 1”. Then loop the above process until the contents of the cells in column “G” are empty. the cells being compared contain a file number with letters and numbers, e.g. ERD2300. Everything I try I get errors and I’m not sophisticated enough (after only three days), to be able to troubleshoot. Problem is I need this data ASAP for my thesis. If anyone can help in any way, I would be hugely grateful - AJ

Bob Phillips
12-13-2010, 01:48 AM
Public Sub ProcessData()
Const NewSheet = "Pastesheet 1"
Dim sourceWs As Worksheet
Dim targetWs As Worksheet
Dim Lastrow As Long
Dim Nextrow As Long
Dim i As Long
Application.ScreenUpdating = False
Set sourceWs = ActiveSheet
On Error Resume Next
Set targetWs = Worksheets(NewSheet)
On Error GoTo 0
If Not targetWs Is Nothing Then
Application.DisplayAlerts = False
targetWs.Delete
Application.DisplayAlerts = True
End If
Set targetWs = Worksheets.Add(after:=Worksheets(Worksheets.Count))
targetWs.Name = NewSheet
With sourceWs
Lastrow = .Cells(.Rows.Count, "I").End(xlUp).Row
For i = 4 To Lastrow
If .Cells(i, "I").Value2 = .Cells(i, "g").Value2 Then
Nextrow = Nextrow + 1
.Cells(i, "A").Resize(, 3).Copy targetWs.Cells(Nextrow, "A")
.Cells(i, "G").Copy targetWs.Cells(Nextrow, "D")
End If
Next i
End With
Application.ScreenUpdating = True
End Sub

akj375
12-13-2010, 09:39 AM
xdl. Thank you so much for the code. I'll work through it for my own understanding and give it a go with my data.

Bob Phillips
12-13-2010, 10:14 AM
A somewhat commented version to help



Public Sub ProcessData()
Const NewSheet = "Pastesheet 1"
Dim sourceWs As Worksheet
Dim targetWs As Worksheet
Dim Lastrow As Long
Dim Nextrow As Long
Dim i As Long
'turn of the screen flashing
Application.ScreenUpdating = False
'get a pointer to the sourec sheet for flexibility later
Set sourceWs = ActiveSheet
'check if the paste sheet already exists, if it does
'then delete it
'set a variable to the paste sheet, wrapped in On Error in casew
'it doesn't exist
On Error Resume Next
Set targetWs = Worksheets(NewSheet)
On Error GoTo 0
'then test if it exists, if so delete it
If Not targetWs Is Nothing Then
Application.DisplayAlerts = False
targetWs.Delete
Application.DisplayAlerts = True
End If
'now add a new worksheet and name it
Set targetWs = Worksheets.Add(after:=Worksheets(Worksheets.Count))
targetWs.Name = NewSheet
With sourceWs
'get the last row in column I
Lastrow = .Cells(.Rows.Count, "I").End(xlUp).Row
'starting at row 4 until the last row
For i = 4 To Lastrow
'check if the values in columns G and I are the same
If .Cells(i, "I").Value2 = .Cells(i, "G").Value2 Then
'if so, increment the row index for the paste sheet
Nextrow = Nextrow + 1
'copy columns A:C to the past sheet
.Cells(i, "A").Resize(, 3).Copy targetWs.Cells(Nextrow, "A")
'then copy columns G as well
.Cells(i, "G").Copy targetWs.Cells(Nextrow, "D")
End If
Next i
End With
Application.ScreenUpdating = True
End Sub

akj375
12-13-2010, 10:29 AM
Xld - Again... many many thanks. Ultimately it's all about learning how to do it myself so the comments are a huge help :)