Excel vba if value is in column then [closed] - excel

Question

Closed. This question needs to be more focused. It is not currently accepting answers.
Want to improve this question? Update the question so it focuses on one problem only by editing this post.
Closed 4 years ago.
Improve this question
I want to make a macro via an if then else function (maybe make use of a loop).
I have two separate files, named "orderregistratie" + "werkorder template".
I want to search in column A of sheets("datablad") in orderregistratie for the value sheets("export datablad").Range("A2") that is in werkorder template.
If this value exists in column A then copy the row of A2 from export datablad and paste it in the row where the value is found.
If it doesn't already exist I want to insert a new row at A2 in orderregistratie and copy the row of A2 from export datablad in the new row.
My VBA knowledge is not really good and I can't write the macro by myself. Is there anyone who can help me write it?

Answer 1

Give this a try. I'll adjust as needed. Just be double check if both workbooks are saved to your desktop.
Option Explicit
Private wkbOrderReg As Workbook, _
wkbOrderWork As Workbook, _
wkb As Workbook
Private wsOBJ As Worksheet, _
ws As Worksheet
Private rngSearch As Range, _
rngRow As Range, _
rng As Range, _
r As Range
Private strSearch As String
Public Sub DarudeSandStorm()
Dim LastRow As Long, _
LastColumn As Long
Dim arr As Variant
With Application.Workbooks
Set wkbOrderReg = .Open(Filename:=strVar("orderregistratie.xlsx"))
Set wkbOrderWork = .Open(Filename:=strVar("werkorder template.xlsx"))
End With
With wkbOrderWork
For Each ws In .Worksheets
Set wsOBJ = ws
If UCase$(wsOBJ.Name) = UCase$("export datablad") Then
With wsOBJ
Set rng = .Range(.Cells(2, 1), .Cells(2, 1))
strSearch = rng.Value
LastColumn = getLAST_COLUMN(wsOBJ)
Set rngRow = .Range(.Cells(2, 1), .Cells(2, LastColumn))
End With
arr = rngRow
Exit For
End If
Next ws
End With
With wkbOrderReg
For Each ws In .Worksheets
Set wsOBJ = ws
If UCase$(wsOBJ.Name) = UCase$("export datablad") Then
With wsOBJ
LastRow = getLAST_ROW(wsOBJ)
Set rngSearch = .Range(.Cells(1, 1), .Cells(LastRow, 1))
End With
For Each r In rngSearch
If UCase$(r.Value) = UCase$(strSearch) Then
r = arr
End If
Next r
End If
Next ws
End With
With Application
For Each wkb In .Workbooks
If Not wkb = .ThisWorkbook Then
With .Workbooks(wkb.Name)
.Save
.Close
End With
End If
Next wkb
End With
End Sub
Private Function getLAST_COLUMN(objWS As Worksheet) As Long
Dim wsDES As Worksheet, _
wkbSUB As Workbook, _
rngCHECK As Range
Set rngCHECK = objWS.Cells.Find(What:="*", _
After:=Range("A1"), _
LookIn:=xlFormulas, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=False)
If Not rngCHECK Is Nothing Then
getLAST_COLUMN = objWS.Cells.Find("*", _
Range("A1"), _
xlFormulas, _
, _
xlByColumns, _
xlPrevious).Column
Else
getLAST_COLUMN = 1
End If
End Function
Private Function getLAST_ROW(objWS As Worksheet) As Long
Dim wsDES As Worksheet, _
wkbSUB As Workbook, _
rngCHECK As Range
Set rngCHECK = objWS.Cells.Find(What:="*", _
After:=Range("A1"), _
LookIn:=xlFormulas, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=False)
If Not rngCHECK Is Nothing Then
getLAST_ROW = objWS.Cells.Find("*", _
Range("A1"), _
xlFormulas, _
, _
xlByRows, _
xlPrevious).Row
Else
getLAST_ROW = 1
End If
End Function
Private Function strVar(ByRef str As String) As String
strVar = Environ("Userprofile") & "\Desktop\" & str
End Function

Answer 2

#Mischa Urlings for this example i have save both workbooks ("orderregistratie" + "werkorder template") on my desktop so you must change their path on the code.
Option Explicit
Sub test()
Dim WbO As Workbook
Dim WbW As Workbook
Dim i As Long
Dim LRA As Long
Dim RowToCopy As Long
Dim Rowstr As Long
Dim Searchstr As String
Dim Address As Range
Dim Searchrng As Range
Workbooks.Open Filename:="C:\Users\xxxx\Desktop\" & "orderregistratie.xlsx" '<= Open Workbooks (for this example files are stored on desktop
Workbooks.Open Filename:="C:\Users\xxxx\Desktop\" & "werkorder template.xlsx"
Set WbO = Workbooks("orderregistratie.xlsx") '<= Set workbook to variables
Set WbW = Workbooks("werkorder template.xlsx")
LRA = WbW.Worksheets("export datablad").Range("A" & Rows.Count).End(xlUp).Row '<= Find Lastrow
For i = 2 To LRA '<= Loop column A (Workbook:werkorder template)
Searchstr = WbW.Worksheets("export datablad").Range("A" & i).Value '<= Set what to search for
Rowstr = i '<= Searchstr row
Set Searchrng = WbO.Worksheets("datablad").Columns("A") '<= Set where to search for
Set Address = Searchrng.Find(What:=Searchstr, LookAt:=xlWhole) '<= Result of the search
If Address Is Nothing Then
'If what we search for not found
WbO.Worksheets("datablad").Rows("2").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
WbW.Worksheets("export datablad").Rows(Rowstr).EntireRow.Copy
WbO.Worksheets("datablad").Rows(2).PasteSpecial Paste:=xlPasteValues
Else
'If what we search for found
RowToCopy = Address.Row '<= Where we find the Searchstr
WbW.Worksheets("export datablad").Rows(i).EntireRow.Copy
WbO.Worksheets("datablad").Rows(RowToCopy).PasteSpecial Paste:=xlPasteValues
End If
Next i
With WbO
.Save
.Close '<= Close open workbooks
End with
With WbW
.Save
.Close '<= Close open workbooks
End with
End Sub