Wednesday, 21 August 2013

VBA how to loop from the first cell/column (Force it)

VBA how to loop from the first cell/column (Force it)

Below are my codes, I am trying to force the checking to start from the
first cell, but it doesn't work. Can anyone advise me on that. Thanks
I am trying to do checking on the names which is on the 3rd column of
Workbook A and compare it with the other column in another workbook. Upon
match of the string, it will copy certain cells to the desalinated column
Sub copyandpaste()
Set From_WS = Workbooks("copy_data2").Worksheets("Data")
Set To_WS = Workbooks("Book1").Worksheets("Sheet1")
Dim v1 As String
Dim v2 As String
Dim diffRow As Long
Dim dataWs As Worksheet
Dim copyWs As Worksheet
Dim rowData As Long
Dim totRows As Long
Dim lastRow As Long
Dim mycellA As Range
Dim mycellB As Range
Dim srRangToCheck As Range
Dim result As String
Dim row_no As Integer
Dim Name As Range
Dim Namelist As Range
diffRow = 1 'compare
Set dataWs = Worksheets("Data")
Set copyWs = Worksheets("Diff")
row_no = row_no + 1
For Each C In Worksheets("Data").Range("C2:C10")
If C.Value <> "" Then
v1 = C
End If
For Each d In Workbooks("Book1").Worksheets("Sheet1").Range("B2:B10")
If d.Value <> "" Then
v2 = d
End If
With From_WS.Cells(1, 2).CurrentRegion
Total_Rows = .Rows.Count
Total_Columns = .Columns.Count
End With
Set mycellA = From_WS.Range("C:C")
Set mycellB = To_WS.Range("B:B")
copy = False
' With Sheets("copy_data2")
' lastRow = .Range("A" & .Rows.Count).End(xlUp).Row
Set selectedCell = selectedCell + 1
For i = 6 To 1200
If v1 = v2 Then
'select sheet
Sheets("Data").Select
'ActiveCell.Select 'select active cell
ActiveCell.Interior.ColorIndex = 36 'color the cell
'result = ActiveCell.EntireRow.copy
'copy active cell
ActiveCell.Range("A2:F2").copy
'Paste file destination
Sheets("Diff").Select
'Paste cell destination !!!!!!!!!!!! issue copy other book
'Set dlsheet = appexcel.Workbooks.Open(strPath & "Book1.xls")
'Workbooks.Open Filename:="C:Desktop\copy_data2\Book1.xls"
'dlsheet.Range("B2").Select
'Paste cell destination
Sheets("Diff").Range("A2").Select
'Paste Active
ActiveSheet.Paste
'===============================================================
'select sheet
Sheets("Data").Select
'ActiveCell.Select 'select active cell
ActiveCell.Interior.ColorIndex = 36 'color the cell
'result = ActiveCell.EntireRow.copy
'copy active cell
ActiveCell.Range("G7:H7").copy
'Paste file destination
Sheets("Diff").Select
'Paste cell destination
Sheets("Diff").Range("J2").Select
'Paste Active
ActiveSheet.Paste
'Sheets("Sheet1").ActiveCell.Range("C17").PasteSpecial xlPasteValues
'Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats,
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
'paste
'Worksheets("Sheet1").Range("A3").Offset(1).EntireRow.Insert
'Worksheets("Diff").Range("A1").PasteSpecial Transpose:=False
Else
If IsEmpty(Cells(i, 1)) = True Then 'if cells in column "A" is empty
then stop
Exit For
End If
Next i
Next d
Next C
End Sub

No comments:

Post a Comment