I am starting out with VBA and have encountered issues with the following code. Ultimately I just want to store the row for use later. Can someone assist me please?
Sub UpdateQuote()
Dim wb As Workbook
Dim ws As Worksheet
Dim FoundCell As Range
Dim FoundRow As Range
Dim FindValue As String
Set wb = ActiveWorkbook
Set ws = ActiveSheet
FindValue = Sheet24.Range("D3")
Set FoundCell = Sheet20.Range("A:A").Find(What:=FindValue)
Set FoundRow = FoundCell.Row
Application.ScreenUpdating = False
MsgBox FoundRow
End Sub
Related
Thank you in advance, I need help in completing the below code, the code currently works to add the number of rows in the Table(3) of my word template as per the available rows in excel table, the word template have one row to begin with.
How can I pass the value from excel table range Set Rng = wsSheet.Range("A2:C" & lastrow)
Option Explicit
Sub CopyToWordTemplate()
Const stWordDocument As String = "TemplateSD.docm"
Dim intNoOfRows
Dim objWord As Word.Application
Dim objDoc As Word.Document
Dim wbBook As Workbook
Dim wsSheet As Worksheet
Dim lRow, i, lastrow, lastcol As Long
Dim vaData As Variant
Dim Rng As Range
Set wbBook = ThisWorkbook
Set wsSheet = wbBook.Worksheets("Transmittal")
lastrow = wsSheet.Range("A2").End(xlDown).Row
lastcol = wsSheet.Range("C2").End(xlToRight).Column
Set Rng = wsSheet.Range("A2:C" & lastrow)
Rng.ClearContents
Copy_Criteria_Text
lRow = wsSheet.Range("A2").End(xlDown).Row
intNoOfRows = lRow - 1
Set objWord = New Word.Application
objWord.Visible = True
Set objDoc = objWord.Documents.Open("\\Dn71\dn071\DOCUMENT CONTROL\Common\X-
Templates\Document Control\" & stWordDocument)
With objWord.ActiveDocument
.Bookmarks("Description").Range.Text = wsSheet.Range("D1").Value
.Bookmarks("RevNumber").Range.Text = "C" & wsSheet.Range("E1").Value
.Bookmarks("SubmittalNumber").Range.Text = "DN071-P02-CRC-GEN-PMT-SDA-" & wsSheet.Range("F1").Value
End With
For i = 2 To intNoOfRows
objDoc.Tables(3).Rows.Add
Next
Set objWord = Nothing
End Sub
I would like to atomatize an excel process using VBA.
The script has to go cell by cell in a selected area on Sheet3. Each cell contains a number or is blank.
The script will go and search for the value of each cell in a specific range on Sheet2. When it finds something the content of the whole row where it was found must go bold.
If it finds nothing it will just procede to the next cell.
After browsing here on stackoverflow and different guides I've managed to put together a script. It has no errors but it doesn't do Anything.
Sub MacroText()
Dim xlRng As Range
Dim rng As Range
Dim xlSht As Worksheet
Dim sht As Worksheet
Dim iLastRow As Integer
Dim iRow As Integer
Dim bFound As Boolean
Dim xCell As Range
Dim xlCell As Range
Dim valueToFind As String
bFound = False
Set sht = ActiveWorkbook.Worksheets("Sheet3")
Set xlSht = ActiveWorkbook.Worksheets("Sheet2")
Set rng = Selection
Set xlRng = ActiveWorkbook.Worksheets("Sheet2").Range("A:A")
iLastRow = xlSht.Range("A1").End(xlDown).Row
Set xlRng = xlSht.Range("A1:A" & iLastRow)
For Each xCell In rng
valueToFind = xCell.Value
For Each xlCell In xlRng
Worksheets("Sheet2").Activate
If xlCell.Value = valueToFind Then
bFound = True
iRow = xlCell.Row
Rows(iRow).Font.Bold = True
End If
If bFound = True Then Exit For
End
Next xlCell
Next xCell
End Sub
I am assuming that it has to be something with positioning within the code but I couldn't find any information for that.
After working on this for 12 hours I would really appreciate your help.
Cheers!
You could use the Find method to achieve this instead of the second loop
Sub MacroText()
Dim xlRng As Range
Dim rng As Range
Dim xlSht As Worksheet
Dim sht As Worksheet
Dim iLastRow As Long
Dim iRow As Long
Dim bFound As Boolean
Dim xCell As Range
Dim xlCell As Range
Dim valueToFind As String
Dim FoundRange As Range
bFound = False
Set sht = ActiveWorkbook.Worksheets("Sheet3")
Set xlSht = ActiveWorkbook.Worksheets("Sheet2")
Set rng = Selection
Set xlRng = ActiveWorkbook.Worksheets("Sheet2").Range("A:A")
iLastRow = xlSht.Range("A1").End(xlDown).Row
Set xlRng = xlSht.Range("A1:A" & iLastRow)
For Each xCell In rng
Set FoundRange = Nothing
Set FoundRange = xlRng.Find(what:=xCell.Value2)
If Not FoundRange Is Nothing Then
FoundRange.EntireRow.Font.Bold = True
End If
Next xCell
End Sub
For Each xlCell In xlRng
Worksheets("Sheet2").Activate
If xlCell.Value = valueToFind Then
xlCell.EntireRow.Font.Bold = True
End If
Next xlCell
I don't know what thing you are not getting, but I assumed that you are not getting desired row as bold. Replace the above code with your's for loop and run.
I didn't tested it, but am uncertain about not working.
I am trying to copy over values from one workbook to another using the usedrange function (there are some blanks in certain rows and it is fine to copy over the blank as well), but I am getting the 1004 error:
Sub ActiveInactiveVendors()
Dim ActiveWkb As Workbook, Wkb As Workbook, InactiveWkb As Workbook
Dim ActiveWkst As Worksheet, Wkst As Worksheet, InactiveWkst As Worksheet
Dim aCell As Range
Dim targetRng As Range
Set ActiveWkb = Workbooks.Open("C:\Users\clara\Desktop\active vendors.xlsx")
Set Wkb = ThisWorkbook
Set Wkst = Wkb.Sheets("Vendors")
Set ActiveWkst = ActiveWkb.Worksheets("aqlc7da48e7")
'set column A starting from A7
Set targetRng = Wkst.Range("A7" & Wkst.Rows.Count)
'get the values starting from a32 to the last row used and set it in wkst
targetRng.Value = ActiveWkst.Range("A32" & ActiveWkst.UsedRange.Rows.Count).Value
End Sub
I appreciate any feedback! Thank you
This line:
Set targetRng = Wkst.Range("A7" & Wkst.Rows.Count)
is not correct. You are not getting A7:A1048576 but a concatenating of the two. So it is looking for A71048576 which does not exist
Then you should use similar sized ranges when setting values.
Sub ActiveInactiveVendors()
Dim ActiveWkb As Workbook, Wkb As Workbook, InactiveWkb As Workbook
Dim ActiveWkst As Worksheet, Wkst As Worksheet, InactiveWkst As Worksheet
Dim aCell As Range
Dim targetRng As Range, origRng As Range
Set ActiveWkb = Workbooks.Open("C:\Users\clara\Desktop\active vendors.xlsx")
Set Wkb = ThisWorkbook
Set Wkst = Wkb.Sheets("Vendors")
Set ActiveWkst = ActiveWkb.Worksheets("aqlc7da48e7")
'set column A starting from A7
Set origRng = ActiveWkst.Range("A32", ActiveWkst.Cells(ActiveWkst.Rows.Count, 1).End(xlUp))
Set targetRng = Wkst.Range("A7", Wkst.Cells(origRng.Rows.Count + 6, 1))
'get the values starting from a32 to the last row used and set it in wkst
targetRng.Value = origRng.Value
End Sub
Hello I'm trying to copy columns C, R, W,X from file 1 to file 2 with below code but keep getting an error. My VBA knowledge isn't that good yet but probably has to do with the range setting? I've tried multiple ways but can't get it to work.
Am I using the right setting or should I use another action to get the specific columns?
Sub PFS()
Dim wbCopy As Workbook
Dim wsCopy As Worksheet
Dim rngCopy As Range
Dim wbPaste As Workbook
Dim wsPaste As Worksheet
Dim rngPaste As Range
Set wbPaste = ActiveWorkbook
Set wbCopy = Workbooks.Open("path to copy")
Set wsCopy = wbCopy.Worksheets("Blad1")
Set rngCopy = wsCopy.Range("d, e").EntireColumn
Set wsPaste = wbPaste.Worksheets("PFS")
Set rngPaste = wsPaste.Range("a1")
rngCopy.Copy
rngPaste.PasteSpecial
Workbooks.Application.CutCopyMode = False
Application.DisplayAlerts = False
wbCopy.Save
wbCopy.Close
End Sub
Solutions to copy entire column.
Sub copy()
Dim wb As Workbook
Dim wbNew As Workbook
Dim ws As Worksheet
Dim wsNew As Worksheet
Set wb = ActiveWorkbook
Set ws = wb.Sheets("old")
Set wbNew = Workbooks("Book.xlsx")
Set wsNew = wbNew.Sheets("new")
ws.Columns(3).copy
wsNew.Columns(3).Insert Shift:=xlToRight
ws.Columns(18).copy
wsNew.Columns(18).Insert Shift:=xlToRight
ws.Columns(23).copy
wsNew.Columns(23).Insert Shift:=xlToRight
ws.Columns(24).copy
wsNew.Columns(24).Insert Shift:=xlToRight
Set wsNew = Nothing
Set wbNew = Nothing
Set ws = Nothing
Set wb = Nothing
End Sub
I'm trying to open a workbook and delete a sheet from it, but it runs the code without errors, and the sheet is still there...
I'm able to modify it, as I changed formulas to values on another sheet.
First of all - Yes, I know the "i" variable is set to do 1 iteration.
Somehow, now when I open the workbook it says it's locked by me - which I don't even know how to do.
So...how can I unlock it? When I go to File-->Info-->Permissions it says 'Anyone can copy, change and modify any part of this workbook.... I can delete the sheet manually as well...
Here's the code:
Sub Change()
Dim wb As Excel.Workbook
Set wb = ThisWorkbook
Dim ws As Excel.Worksheet
Set ws = wb.Sheets("FileSearch Results")
Dim rng As Range
Set rng = ws.UsedRange
Dim cPaths As Integer
cPaths = rng.Column
Dim i As Integer
i = rng.Row
Dim oExcel As Excel.Application
Set oExcel = New Excel.Application
Dim oWB As Workbook
Dim komm As Excel.Worksheet
Dim sh1 As Excel.Worksheet
Do While i < 2
Dim pth As String
pth = ws.Cells(i, cPaths)
Set oWB = oExcel.Workbooks.Open(pth)
Set sh1 = oWB.Worksheets("Sheet1")
With sh1.UsedRange
.Value = .Value
End With
Set komm = oWB.Worksheets("Kommentar")
Application.DisplayAlerts = False
komm.Delete
Application.DisplayAlerts = True
oWB.Close savechanges:=True
i = i + 1
Loop
End Sub
Any ideas?
Sub Change()
Dim wb As Excel.Workbook
Set wb = ActiveWorkbook 'ThisWorkbook
Dim ws As Excel.Worksheet
Set ws = wb.Sheets("FileSearch Results")
Dim rng As Range
Set rng = ws.UsedRange
Dim cPaths As Integer
cPaths = rng.Column
Dim i As Integer
i = rng.row
'Dim oExcel As Excel.Application ***CHANGED***
'Set oExcel = New Excel.Application ***CHANGED***
'Dim oWB As Workbook ***CHANGED***
Dim komm As Excel.Worksheet
Dim sh1 As Excel.Worksheet
Do While i < 2
Dim pth As String
pth = ws.Cells(i, cPaths)
'Set oWB = oExcel.Workbooks.Open(pth) ***CHANGED***
Workbooks.Open (pth) '***ADDED***
Set sh1 = ActiveWorkbook.Worksheets("Sheet1") 'oWB.Worksheets("Sheet1") ***CHANGED***
With sh1.UsedRange
.Value = .Value
End With
Set komm = ActiveWorkbook.Worksheets("Kommentar") 'oWB.Worksheets("Kommentar") ***CHANGED***
Application.DisplayAlerts = False
komm.Delete
Application.DisplayAlerts = True
ActiveWorkbook.Close savechanges:=True 'oWB.Close savechanges:=True ***CHANGED***
i = i + 1
Loop
End Sub
This now opens the workbook and deletes the sheet in the foreground rather than invoking a new instance of Excel and deleting the sheet in the background. This is why the file stays locked, as the new instance which isn't closed by the code, still holds it.
For anyone running into this in the future (like myself), the actual problem is with the mix up in scope when calling Application.DisplayAlerts.
komm is a sheet in oWB, which exists in the new instance of excel oExcel.
Application is a completely different instance and therefor has no effect.
Since the code isn't actually disabling the prompt in the correct instance of excel (oExcel) and it is presumably not visible, the code will just ignore the command and move on.
The simple fix is to use oExcel instead of Application:
Set komm = oWB.Worksheets("Kommentar")
oExcel.DisplayAlerts = False
komm.Delete
oExcel.DisplayAlerts = True