Trying to loop rows of another Workbook's sheet - vba

I have two Workbooks where I need to compare ID's from the one where I write the script and to other one I need to access from the script.
I loop through all numbers in sheet and record each ID in "tmpFisNo". After that I make one loop for iterating through other Workbook's rows and compare them.
However, it says "Mismatch Error" in line For j = ws.Cells(9, 9).Value To ws.Cells(10, 9).Value
Dim i As Integer
Dim j As Integer
Dim tmpFisNo As String
Dim tmpFisNo2 As String
Dim wbThis As Workbook
Dim wbTarget As Workbook
Dim wbPath As String
Dim ws As Worksheet
Sub Dogrula_Click()
wbPath = Cells(8, 9).Value
Set wbThis = ActiveWorkbook
Set wbTarget = Workbooks.Open("2015_OCAK_MUTABAKAT_RAPORU")
Set ws = wbTarget.Sheets(2)
For i = Cells(5, 9).Value To Cells(6, 9).Value
tmpFisNo = Cells(i, 2).Text
For j = ws.Cells(9, 9).Value To ws.Cells(10, 9).Value
tmpFisNo2 = ws.Cells(j, 4).Text
If tmpFisNo = tmpFisNo2 Then
Cells(i, 7).Value = 1
End If
Next j
Next i
End Sub

Try
Dim i As Long
Dim j As Long
Dim tmpFisNo As String
Dim tmpFisNo2 As String
Dim wbThis As Workbook
Dim wbTarget As Workbook
Dim wbPath As String
Dim ws As Worksheet
Sub Dogrula_Click()
wbPath = Cells(8, 9).Value
Set wbThis = ActiveWorkbook
Set wbTarget = Workbooks.Open("2015_OCAK_MUTABAKAT_RAPORU")
Set ws = wbTarget.Sheets(2)
For i = Cells(5, 9).Value To Cells(6, 9).Value
tmpFisNo = Cells(i, 2).Text
dim a as Long, b as Long
a = CLng(ws.Cells(9, 9).Value)
b = CLng(ws.Cells(10, 9).Value)
For j = a To b
tmpFisNo2 = ws.Cells(j, 4).Text
If tmpFisNo = tmpFisNo2 Then
Cells(i, 7).Value = 1
End If
Next j
Next i
End Sub
If it gives you an error on the CLngs then it's because you have some values in the spreadsheet in cells (9,9) or (10,9) which aren't integers
I would also recommend using Long instead of Integer - you can't reach all the cells in the worksheet using Integer (even for the old versions of Excel)

Related

Last Row and Offset Combination

I cant find out what is problem with this code. when I run it I got compile error for LRow. I would be grateful if you help. Thanks in advance.
Dim NameTxb As String
Dim DateTxb As Date
Dim WYSTxb As Date
Dim WYETxb As Date
Dim DivCmb As String
Dim PosCmb As String
Dim VacCmb As Integer
Dim Add1Cmb As Integer
Dim Add2Cmb As Integer
Dim MDB As Worksheet: Set MDB = ThisWorkbook.Worksheets("MainDataBase")
Dim LRow As Long: LRow = MDB.Cells(MDB.Rows.Count, "A").End(xlUp).Row
With Worksheets("MainDataBase").LRow
LRow.Offset(1, 0).Value = AddWorker.NameTxb.Value
LRow.Offset(0, 1).Value = AddWorker.DivCmb.Value
LRow.Offset(0, 2).Value = AddWorker.PosCmb.Value
LRow.Offset(0, 3).Value = AddWorker.DateTxb.Value
LRow.Offset(0, 4).Value = AddWorker.WYSTxb.Value
LRow.Offset(0, 5).Value = AddWorker.WYETxb.Value
LRow.Offset(0, 6).Value = AddWorker.VacCmb.Value
LRow.Offset(0, 7).Value = AddWorker.Add1Cmb.Value
LRow.Offset(0, 7).Value = AddWorker.Add2Cmb.Value
End With
End sub
With MDB
.Range("A" & LRow).Offset(1, 0).Value =
.Range("A" & LRow).Offset(0, 1).Value =
Lrow will just be a number, not the row. SO you need to say Worksheets("MainDataBase").row(lrow)

Code wont loop through sheets as well as rows

I am trying to write code to loop through all sheets in a workbook, apart from 1, and add a column which is a concatenation of 3 others. This seems to loop through all the rows for one worksheet, but not the others in the book
Sub addConcats()
Dim sh As Worksheet
Dim rw As Range
Dim RowCount As Integer
'Run through worksheets
Dim x As Long
Sheet1.Select
For x = 2 To ThisWorkbook.Sheets.Count
If Sheets(x).Name <> "VAT Transaction Report" Then Sheets(x).Select
Replace:=False
Dim LastRow As Long
LastRow = ActiveSheet.UsedRange.Row - 1 + ActiveSheet.UsedRange.Rows.Count
For y = 2 To LastRow
'Concat
ActiveSheet.Cells(y, 20).Value = ActiveSheet.Cells(y, 7).Value &
ActiveSheet.Cells(y, 9).Value & ActiveSheet.Cells(y, 12).Value
Next y
Next x
End Sub
No need to select each worksheet for this, or run with x and y.
Sub addConcats()
Dim sh As Worksheet
Dim LastRow As Long
For Each sh in ThisWorkbook.Worksheets
If sh.Name <> "VAT Transaction Report" Then
LastRow = sh.Cells(sh.Rows.Count, 1).End(xlUp)
For y = 2 To LastRow
'Concat
sh.Cells(y, 20).Value = sh.Cells(y, 7).Value & sh.Cells(y, 9).Value & sh.Cells(y, 12).Value
Next y
End If
Next
End Sub
Try the code below, for your For loop to take into consideration the Sheets(x) you are trying to update:
Dim LastRow As Long
For x = 2 To ThisWorkbook.Sheets.Count
If Sheets(x).Name <> "VAT Transaction Report" Then
With Sheets(x)
LastRow = .UsedRange.Row - 1 + .UsedRange.Rows.Count
For y = 2 To LastRow
'Concat
.Cells(y, 20).Value = .Cells(y, 7).Value & .Cells(y, 9).Value & .Cells(y, 12).Value
Next y
End With
End If
Next x
The problem is that you select a sheet, but do not use Sheet.Activate. Next you use ActiveSheet. It is better to avoid selecting sheets altogether and just work against a Worksheet object (sh variable)
Try the following:
Sub addConcats()
Dim sh As Worksheet
Dim x As Integer
Dim y As Integer
Dim LastRow As Long
For x = 1 To ThisWorkbook.Sheets.Count
Set sh = Sheets(x)
If sh.Name <> "VAT Transaction Report" Then
LastRow = sh.UsedRange.Rows.Count
For y = 2 To LastRow
'Concat
sh.Cells(y, 20).Value = sh.Cells(y, 7).Value & sh.Cells(y, 9).Value & sh.Cells(y, 12).Value
Next y
End If
Next x
End Sub

Conditional copy Excel File-2 data to excel file-1?

I am using Excel 2007. I try to copy Unit-price from the Excel file-2 data to the Excel file-1 when certain columns data matching from file-1 with file-2.
Thanks for the helps & guidance.
My VBA Code:
Sub mySales()
Dim LastRow As Integer, i As Integer, erow As Integer, Pipe_Class As String, Pipe_Description As String, End_Type As String, Pipe_Size As String
Dim wbk As Workbook
strPriceFile = "C:\Temp\File-2.xlsx"
LastRow = ActiveSheet.Range(“A” & Rows.Count).End(xlUp).Row
For i = 2 To LastRow
Pipe_Class = ""
Pipe_Description = ""
End_Type = ""
Pipe_Size = ""
Pipe_Class = ActiveSheet.Cells(i, 1).Value
Pipe_Description = ActiveSheet.Cells(i, 2).Value
End_Type = ActiveSheet.Cells(i, 3).Value
Pipe_Size = ActiveSheet.Cells(i, 4).Value
Set wbk = Workbooks.Open(strPriceFile)
Worksheets("SOR2").Select
If Cells(i, 1) = Pipe_Class And Cells(i, 2) = Pipe_Description And Cells(i, 3) = End_Type And Cells(i, 4) = Pipe_Size Then
Range(Cells(i, 12), Cells(i, 12)).Select
Selection.Copy
??? After Here how select my current file & paste ????????
Worksheets("SOR1").Select
erow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
ActiveSheet.Cells(erow, 12).Select
ActiveSheet.Paste
ActiveWorkbook.Save
End If
Next i
ActiveWorkbook.Close
Application.CutCopyMode = False
End Sub
I haven't checked all your code, but I have refactored what you have in your question in an attempt to open the Workbook once and to assign proper objects so that you can keep track of what action is being applied to which worksheet.
Sub mySales()
Dim LastRow As Integer, i As Integer, erow As Integer
Dim wbSrc As Workbook
Dim wsSrc As Worksheet
Dim wbDst As Workbook
Dim wsDst As Worksheet
Dim strPriceFile As String
Set wbDst = ActiveWorkbook
Set wsDst = ActiveSheet
strPriceFile = "C:\Temp\File-2.xlsx"
Set wbSrc = Workbooks.Open(strPriceFile)
Set wsSrc = wbSrc.Worksheets("SOR2")
LastRow = wsDst.Range("A" & wsDst.Rows.Count).End(xlUp).Row
erow = LastRow + 1
For i = 2 To LastRow
If wsSrc.Cells(i, 1).Value = wsDst.Cells(i, 1).Value And _
wsSrc.Cells(i, 2).Value = wsDst.Cells(i, 2).Value And _
wsSrc.Cells(i, 3).Value = wsDst.Cells(i, 3).Value And _
wsSrc.Cells(i, 4).Value = wsDst.Cells(i, 4).Value Then
wsSrc.Cells(i, 12).Copy wsDst.Cells(erow, 12)
erow = erow + 1 ' your current code would always copies to the same row,
' but I **think** you probably want to copy to the
' next row each time
End If
Next i
wbSrc.Close
If erow > LastRow + 1 Then
wbDst.Save
End If
wbDst.Close
End Sub
The code is completely untested but, even if it doesn't work, at least it should give you an idea of how you should be processing multiple workbooks and multiple worksheets.

VBA EXCEL !can any one help me in how to add an additional workbook in searching range in below code ,

can any one help me in how to add an additional workbook in searching range in below code ,
I want to search for a string inserted in "TextBox1" within a range (A2,G2000) of data located in Workbook "officerA" Worksheet "DATA", and then paste results found into Workbook "Mainwb" sheet "MAIN SCREEN" Range (A5,G500)
I am totally new to VBA and wrote this code quoting from many sources all your support is appreciated
Below is the code used to search within same workbook:
Private Sub CommandButton1_Click()
Dim wb1 As Workbook, Wb2 As Workbook
Dim ws1 As Worksheet, ws2 As Worksheet
Dim strSearch As String
Dim f As Variant
Dim fAddress As String
Dim fRow As Long
Dim cellA As Variant
Dim cellB As Variant
Set Wb2 = Workbooks.Open("C:\Users\elhayani\Desktop\development\AML db\OfficerA.xlsx")
Set wb1 = Workbooks.Open("C:\Users\elhayani\Desktop\development\AML db\Mainwb.xlsm")
Set wb1 = ActiveWorkbook
Set ws2 = wb1.Sheets("MAIN SCREEN").Range("A5:G2000")
Set ws1 = Wb2.Worksheets("DATA")
strSearch = TextBox1.Value
ws1.Range("A5:G2000").ClearContents
Set dmr = Workbooks.Open("C:\Users\aselhayani\Desktop\Excel Reports\OfficerA.xlsx")
Set dmr = Worksheets("DATA")
strSearch = InputBox("Please enter T24 ID:", "Search Value")
pasteRowIndex = 5
If strSearch = vbNullString Then
MsgBox ("User canceled, or did not enter a value.")
Exit Sub
End If
With ws1.Range("A2:G2000")
Set f = .Find(strSearch, LookIn:=xlValues)
If Not f Is Nothing Then
fAddress = f.Address
Do
fRow = f.Row
cellA = ws2.Cells(fRow, 1).Value
cellB = ws2.Cells(fRow, 2).Value
cellC = ws2.Cells(fRow, 3).Value
cellD = ws2.Cells(fRow, 4).Value
cellE = ws2.Cells(fRow, 5).Value
cellF = ws2.Cells(fRow, 6).Value
cellG = ws2.Cells(fRow, 7).Value
ws1.Cells(pasteRowIndex, 1) = cellA
ws1.Cells(pasteRowIndex, 2) = cellB
ws1.Cells(pasteRowIndex, 3) = cellC
ws1.Cells(pasteRowIndex, 4) = cellD
ws1.Cells(pasteRowIndex, 5) = cellE
ws1.Cells(pasteRowIndex, 6) = cellF
ws1.Cells(pasteRowIndex, 7) = cellG
pasteRowIndex = pasteRowIndex + 1
Set f = .FindNext(f)
Loop While Not f Is Nothing And f.Address <> fAddress
End If
End With
MsgBox "Search Done"
End Sub
You should pass the worksheet in the external workbook as a parameter into another sub routine for processing.
Option Explicit
Private Sub CommandButton1_Click()
Const OfficerAPath = "C:\Users\best buy\Downloads\stackoverfow\temp\OfficerA.xlsx"
Const OfficerBPath = "C:\Users\best buy\Downloads\stackoverfow\temp\OfficerB.xlsx"
Dim wb As Workbook
Dim strSearch As String
strSearch = TextBox1.Value
If strSearch = vbNullString Then
MsgBox ("User canceled, or did not enter a value.")
Exit Sub
End If
Worksheets("MAIN SCREEN").Range("A5:G2000").ClearContents
' Process Workbooks OfficerAPath
Set wb = Workbooks.Open(OfficerAPath)
SearchWorksheet wb.Worksheets("DATA"), strSearch
wb.Close False
' Process Workbooks OfficerAPath
Set wb = Workbooks.Open(OfficerBPath)
SearchWorksheet wb.Worksheets("DATA"), strSearch
wb.Close False
MsgBox "Search Done"
End Sub
Sub SearchWorksheet(dmr As Worksheet, strSearch As String)
Dim f As Range, SearchRange As Range
Dim fAddress As String
Dim pasteRowIndex As Long, y As Integer
With dmr
Set SearchRange = .Range("A1", .Range("A" & .Rows.Count).End(xlUp))
End With
With ThisWorkbook.Sheets("MAIN SCREEN")
pasteRowIndex = .Range("A" & Rows.Count).End(xlUp).Row
If pasteRowIndex < 5 Then pasteRowIndex = 5
Set f = SearchRange.Find(strSearch, LookIn:=xlValues)
If Not f Is Nothing Then
fAddress = f.Address
Do
For y = 1 To 7
.Cells(pasteRowIndex, y) = dmr.Cells(f.Row, y).Value
Next
.Cells(pasteRowIndex, 8) = dmr.Parent.Name
pasteRowIndex = pasteRowIndex + 1
Set f = SearchRange.FindNext(f)
Loop While Not f Is Nothing And f.Address <> fAddress
End If
End With
End Sub

For Loop not running. The condition is working fine, but the loop not running when refering another workbook

I would like to change some Book2 value with respect to Book1's value.
Macro code in Book1:
Dim i As Integer
Dim k As Integer
k = Range("Z1")
For i = 1 To k
If Cells(i, 22).Value = "Yes" Then
Windows("Book2").Activate
Cells(i, 11) = ""
Cells(i, 13) = ""
End If
Next i
As commented, you can try re-writing your code like this:
Dim i As Long
Dim ws1 As Worksheet, ws2 As Worksheet
Set ws1 = Workbooks("Book1").Sheets("Sheet1") '~~> change sheet name to suit
Set ws2 = Workbooks("Book2").Sheets("Sheet1")
With ws1
For i = 1 to .Range("Z1").Value
If .Cells(i, 22).Value = "Yes" Then
ws2.Cells(i, 11).Value = ""
ws2.Cells(i, 13).Value = ""
End If
Next
End With