Edit: I took all you advice and edited my code. Now it works!!!
Thank you.
Here is the new code:
Sub WorksheetLoop()
Dim AllWorksheets As Integer
Dim Worksheet As Integer
AllWorksheets = ActiveWorkbook.Worksheets.Count
For Worksheet = 2 To AllWorksheets
Sheets(1).Select
Cells(10, Worksheet).Value = Sheets(Worksheet).TextBoxes(2).Text
Cells(13, Worksheet).Value = Sheets(Worksheet).TextBoxes(3).Text
Cells(18, Worksheet).Value = Sheets(Worksheet).TextBoxes(1).Text
Cells(24, Worksheet).Value = Sheets(Worksheet).TextBoxes(5).Text
Cells(34, Worksheet).Value = Sheets(Worksheet).TextBoxes(6).Text
Cells(34, Worksheet).Value = Sheets(Worksheet).TextBoxes(4).Text
Next Worksheet
End Sub
Original Problem
So there is an excel document, which contains an amount of worksheets.
On the first sheet an overview should be created by the script.
It should start in the 2nd worksheet and should write the content of the textboxes (please don't ask why there are textboxes...) to Cell B10, B13, anso so on.
Then the script should go to worksheet 3 and the content of the textboxes should go to C10, C13,...
You get the idea...
I know that this is only possible to Z....
But why do I keep getting error messages?
My VBA knowlage is very small, so sorry for obvious errors.
Edit: I took the advice about the spaces around &
But I still get "object doesn't support this property or method"
Sub WorksheetLoop()
Dim AllWorksheets As Integer
Dim Worksheet As Integer
AllWorksheets = ActiveWorkbook.Worksheets.Count
For Worksheet = 2 To AllWorksheets
For CellAscii = 66 To (AllWorksheet + 66)
Cell = Chr(CellAscii)
Sheets(1).Select
Range(Cell & "10").Value = Sheets(Worksheet).TextBox2.Text
Range(Cell & "13").Value = Sheets(Worksheet).TextBox3.Text
Range(Cell & "18").Value = Sheets(Worksheet).TextBox1.Text
Range(Cell & "24").Value = Sheets(Worksheet).TextBox5.Text
Range(Cell & "30").Value = Sheets(Worksheet).TextBox6.Text
Range(Cell & "34").Value = Sheets(Worksheet).TextBox4.Text
Next CellAscii
Next Worksheet
End Sub
Just try the following when trying to access textboxes:
Sheets("SheetName").TextBoxes("TextBox Name").Text
Verify that your "SheetName" and "TextBox Name" are correct.
Hope this was usefull for you.
Range doesn't take a reference of schema Ay, it takes one with RyCx.
Anyway use SheetX.Cell to access a particular cell in a particular row and column.
You loop through cells like this:
Sub MyLoop()
For RowCounter = 1 To 20
For ColumnCounter = 1 To 20
Set curCell = Worksheets("Sheet1").Cells(RowCounter , ColumnCounter)
If Abs(curCell.Value) < 0.01 Then curCell.Value = 0
Next ColumnCounter
Next RowCounter
End Sub
The main error in your code is that there is no space before and after &
Change Range(Cell&"10").Value to Range(Cell & "10").Value. Similarly for the rest and your code will run just fine :)
Related
I'm trying to build a new VBA function for Excel. I've got a book of sheets with a front page that always loads first, on this page I've got a combo box that lists all the other sheets in the book and a nice extract button that will pull out the chosen sheet to a new book. (Thanks to those here who helped with that). Now I need a new function that will use the same combo box, but instead only extract a small subset of the chosen sheet.
Unfortunately, that subset isn't on the same rows for every sheet, nor is the number of rows the same (so one sheet, the subset might be 10 rows, on another it might be 12, on another it might be 20, etc etc etc).
On the plus side, there are merged rows (from column A to G) at the start and end of each subset - with specific text, which could be used to search for.
After some back and forth, I've got a better bit of code that I think is almost working:
Sub ZCPS_Extract()
Dim StartRow
Dim EndRow
Dim Zws As Worksheet
Dim wbkOriginal As Workbook
Set wbkOriginal = ActiveWorkbook
StartRow = 1
EndRow = 1
'sets site details into the header of the ZCPS checksheet
Worksheets(Sheet1.CmbSheet.Value).Range("B3").Value = Worksheets("front page").Range("E6")
Worksheets(Sheet1.CmbSheet.Value).Range("D3").Value = Worksheets("front page").Range("N6")
Worksheets(Sheet1.CmbSheet.Value).Range("F3").Value = Worksheets("front page").Range("K6")
Set Zws = Sheets(Sheet1.CmbSheet.Value)
'selects ZCPS block from select estate sheet
StartRow = (Zws.Cells.Find("**** ZCPS Installation").Row) + 1
EndRow = (Zws.Cells.Find("**** Aztec Hotfixes").Row) - 1
'copy above block and paste into Z-MISC starting at row 5
Worksheets(Sheet1.CmbSheet.Value).Range(Cells(StartRow, 1), Cells(EndRow, 7)).Copy Worksheets("Z-MISC").Range("A5")
With ActiveWorkbook.Sheets("Z-MISC")
.Copy
ActiveWorkbook.SaveAs _
"C:\temp\" _
& ActiveWorkbook.Sheets("Z-MISC").Cells(3, 2).Text _
& " ZCPS CheckSheet " _
& Format(Now(), "DD-MM-YY") _
& ".xlsm", _
xlOpenXMLWorkbookMacroEnabled, , , , False
End With
'code to close the original workbook to prevent accidental changes etc
Application.DisplayAlerts = False
wbkOriginal.Close
Application.DisplayAlerts = True
End Sub
It's error on the line for copying, I'm getting a runtime error of "Application-defined or object-defined error" which to my limited knowledge isn't helping me. Any assistance/pointers/suggestions are welcomed.
Sub ismerged()
Dim start As Integer, finish As Integer
For i = 1 To Range("A655").End(3).Row + 1
If Cells(i, "A").MergeCells = True Then
start = i
Exit For
End If
Next
For i = start To Range("A655").End(3).Row + 1
If Cells(i, "A").MergeCells = True Then
finish = i
End If
Next
MsgBox start
MsgBox finish
End Sub
Then I guess you can select your data as you wish.
I'm not sure about the way you reference your sheet. I will assume 'comboboxvalue' contains the name or the number of the sheet you are selecting. Your code should be something like the following.
Sub Z_Extract()
Dim StartRow
Dim EndRow
Dim ws As Worksheet
Set ws = Sheets(comboboxvalue)
StartRow = ws.Cells.Find("**** ZC").Row
EndRow = ws.Cells.Find("****").Row
'Im assuming you have values up to column G
ws.Range(ws.Cells(StartRow, 1), Cells(EndRow, 7)).Copy
'Now that you have the correct Range selected you can copy it to your new workbook
'SelectedRange.Copy Etc.....
'Cleanup
Set ws = Nothing
End Sub
Got it working.
Set Zws = Sheets(Sheet1.CmbSheet.Value)
'selects ZCPS block from selected estate sheet
StartRow = (Zws.Cells.Find("**** ZCPS Installation").Row)
EndRow = (Zws.Cells.Find("**** Aztec Hotfixes").Row) - 1
'copy above block and paste into Z-MISC starting at row 10
Sheets(Sheet1.CmbSheet.Value).Activate
ActiveSheet.Range(Cells(StartRow, 1), Cells(EndRow, 7)).Select
Selection.Copy
Sheets("Z-MISC").Select
Range("A10").Select
ActiveSheet.Paste
I've created a button on one workbook that opens another macro-less workbook. transposeDataMatrices is the sub that will be run on the worksheets in the workbook that is opened:
Private Sub CommandButton21_Click()
Set BEEBook = ThisWorkbook
FileSelect = Application.GetOpenFilename(FileFilter:="Excel Files (*.xl*), *.xl*", Title:="Please select the report to import")
If FileSelect = "False" Then Exit Sub
Set ReportBook = Workbooks.Open(FileSelect)
transposeDataMatrices
End Sub
Within transposeDataMatrices is the following, heavily truncated code (ReportBook is a global variable for the workbook being worked on in trasposeDataMatrices; cArray is a global array):
Public Sub transposeDataMatrices()
ReportBook.Activate
rowCounter = finWkst.UsedRange.Rows.Count
For ii = 1 To wsCount
Worksheets(ii).Activate
pullModelData (ii) ' just pulls some data, off ii worksheet in ReportBook
ReDim indexIDArray(0 To 504) As Integer
Dim j as Integer: j = 0
For Each catName In cArray
Dim totRange As Range
Set catTitle = Worksheets(ii).UsedRange.Find(catName)
If Not catTitle Is Nothing Then
catTitle.Offset(2, 0).Offset(0, 1).Select
ReportBook.Worksheets(ii).Range(Selection, Selection.End(xlToRight).Offset(0, -1)).Select
ReportBook.Worksheets(ii).Range(Selection, Selection.End(xlDown)).Select
Set totRange = Selection
Else
Set totRange = Cells("A1")
EndIf
indexIDArray(j) = j
Next
equipModelVersion rowCounter, indexIDArray
rowCounter = finWkst.UsedRange.Rows.Count
Next ii
End Sub
Sub equipModelVersion(rowCounterDummy As Integer, indexArrayDummy() As String)
ReportBook.Activate
finWkst.Activate
iCol = 1:
Set indexRange = Range(Cells(rowCounterDummy + 1, iCol), Cells(rowCounterDummy + 1 + UBound(valueArrayDummy, 1), iCol))
Dim j As Integer: j = 0
For I = rowCounterDummy + 1 To rowCounterDummy + 1 + UBound(valueArrayDummy, 1)
Cells(I, iCol) = indexArrayDummy(j)
j = j + 1
Next
End Sub
Sub initializeWorkspace()
ReportBook.Activate
finWkst.Activate
Range("A1").Value = "IndexID"
Range("B1").Value = "ModelID"
Range("C1").Value = "UserVersion"
Range("D1").Value = "Equipment"
Range("E1").Value = "Date"
For ii = LBound(cArray) To UBound(cArray)
Cells(1, ii + 5).Value = cArray(ii)
Next
End Sub
I have two questions:
Firstly, when equipModelVersion gets run, it stores the values in the cells of the workbook on the worksheet where the button is located, rather than the workbook that is opened, in a sheet created to store the values.
How do I rectify that?
I tried activating that specific worksheet, using a with statement, and some other quick things I found on Stack Overflow, but nothing worked.
Secondly, when I was debugging the transposeDataMatrices and had it separately, the following line worked:
Set totRange = Range(Range(Selection, Selection.End(xlToRight).Offset(0, -1)), Selection.End(xlDown))
In the macro that I transferred into the workbook with the button, it no longer works, so I had to work around it with:
ReportBook.Worksheets(ii).Range(Selection, Selection.End(xlToRight).Offset(0, -1)).Select
ReportBook.Worksheets(ii).Range(Selection, Selection.End(xlDown)).Select
Set totRange = Selection
Just looks bad.
Why is VBA being so dumb about it, when the code is EXACTLY IDENTICAL, but expanded?
VBA is not smart, it will only do what you tell it to do not what you think you told it to do.
My guess is that somewhere the ReportBook.Worksheets(ii) is losing focus.
It is good practice to always declare the parent when using objects. The easy way is to declare that parent object is as a variable.
in this case:
Dim ws as worksheet
set ws = ReportBook.Worksheets(ii)
then the with the two lines in question use a with statment
with ws
Set totRange =.Range(Selection, Selection.End(xlDown))
end with
You should avoid using the .select command. See here for great information on that. Using it only dirties the code and makes it harder to find the errors.
This program aims to compare two named ranges in two sheets. If the cells values are found in both sheets it highlights cells in green otherwise in red.
In my code below, I get a logical error.
I compare the results in the two sheets manually but I get totally different results.
Public Sub FindBtn_Click()
range1Name = namedRange1TxtBox
range2Name = namedRange2TxtBox
sheet1Name = Sheet1txt
sheet2Name = Sheet2txt
Dim range1No(), range2No() As Variant
range1No() = Range(range1Name)
range2No() = Range(range2Name)
Dim i, j As Integer
Dim cell As Variant 'Range
For i = LBound(range1No()) To UBound(range1No())
For j = LBound(range2No()) To UBound(range2No())
Set cell = Worksheets(sheet1Name).Range(range1Name).Find(what:=Worksheets(sheet2Name).Range(range2Name).Cells(i, 1).Value, lookat:=xlWhole)
If Not cell Is Nothing Then ' if jde cell value is found in tops then green jde cell
Worksheets(sheet1Name).Range(range1Name).Cells(i, 1).Interior.ColorIndex = 4
Else
Worksheets(sheet1Name).Range(range1Name).Cells(i, 1).Interior.ColorIndex = 3
End If
Application.StatusBar = "Progress: " & i & " of " & UBound(range1No()) '& Format(i / 9331, "%")
Next j
Next i
Without spending a while on in, I'm not too sure what's actually wrong with your code. But how about doing it this way (I substituted strings in the variables so I could make it work locally).
Public Sub FindBtn_Click()
range1Name = "firstrange"
range2Name = "secondrange"
sheet1Name = "Sheet1"
sheet2Name = "Sheet2"
Dim range1cell As Range
Dim range2cell As Range
For Each range1cell In Range(range1Name)
range1cell.Interior.ColorIndex = 3
For Each range2cell In Range(range2Name)
If range1cell.Value = range2cell.Value Then
range1cell.Interior.ColorIndex = 4
Exit For
End If
Next range2cell
Next range1cell
End Sub
On looking closer, I notice that while you're looping through values of j you don't seem to refer to j anywhere else.
the following code solved my problem basicly I don't know how to use the find function properly. below a code that does the job :)
Thanks :)
Dim cell1 As Range, cell2 As Range
Dim add1 As Variant
With Worksheets("JDE").Range("JS_No")
For Each cell2 In Worksheets("TOPS").Range("TechID")
Set cell1 = .Find(cell2, LookIn:=xlValues)
If Not cell1 Is Nothing Then
add1 = cell1.Address
Do
cell1.Interior.ColorIndex = 4
cell2.Interior.ColorIndex = 4
Application.StatusBar = "Processing: " & add1
Loop While Not cell1 Is Nothing And cell1.Address <> add1
End If
Next cell2
End With
I'm new to VBA and am trying to design a program that will go through a column with Strings in it and for every unique String name create a new worksheet object with that String value as its name and then copy and paste the values in that row to the new sheet. All identical Strings should then also have the values in their row copied over to the new sheet. I'm not even sure if the program itself works, but before I can check I keep getting an error that I haven't been able to fix.
The error is run time error '9' subscript out of range.
The thing is the new sheet is getting created but is not getting filled up with any data. It's as if the program goes straight to the else statement and then finds an error that I'm not sure how to fix even though it should be going through the If statement at least once because I know that the String in A3 is the same as that in A2. Here's the full code:
Sub FilterByClass()
Dim i As Long
Dim j As Long
Dim sheetName As String
ActiveSheet.Name = "AllClasses"
sheetName = Worksheets("AllClasses").Cells(2, 1).Value
Worksheets.Add
ActiveSheet.Name = sheetName
Worksheets("AllClasses").Activate
Worksheets(sheetName).Rows(1) = ActiveSheet.Rows(1)
Worksheets(sheetName).Rows(2) = ActiveSheet.Rows(2)
j = 3
For i = 3 To Rows.Count
If Cells(i, 1).Value = Cells(i - 1, 1).Value Then
Worksheets(Cells(i, 1).Value).Rows(j) = ActiveSheet.Rows(i)
j = j + 1
Else
Worksheets.Add
ActiveSheet.Name = ThisWorkbook.Sheets(sheetName).Cells(i, 1).Value
Worksheets("AllClasses").Activate
j = 1
Worksheets(Cells(i, 1).Value).Rows(j) = ActiveSheet.Rows(1)
j = j + 1
Worksheets(Cells(i, 1).Value).Rows(j) = ActiveSheet.Rows(i)
End If
Next i
End Sub
Any help would be appreciated. And if you see anything in the rest of the code that looks like it clearly won't work as intended please point it out as well. Thanks
Before you name a worksheet, check if the sheet exists like David mentioned in the comments.
Here is my favorite way of checking if the sheet exists
Sub Sample()
If DoesSheetExist("AllClasses") Then
MsgBox "Sheet Already Exists"
Else
ActiveSheet.Name = "AllClasses"
End If
End Sub
Function DoesSheetExist(Sh As String) As Boolean
Dim ws As Worksheet
On Error Resume Next
Set ws = ThisWorkbook.Sheets(Sh)
On Error GoTo 0
If Not ws Is Nothing Then DoesSheetExist = True
End Function
Also if the sheet doesn't exist then it may be possible that the workbook is protected. To check if that is the case, you can use the below code
If ThisWorkbook.ProtectStructure = True Then
MsgBox "Workbook structure is protected"
Else
MsgBox "Workbook structure is not protected"
End If
How do I code Excel VBA to retrieve the url/address of a hyperlink in a specific cell?
I am working on sheet2 of my workbook and it contains about 300 rows. Each rows have a unique hyperlink at column "AD". What I'm trying to go for is to loop on each blank cells in column "J" and change it's value from blank to the hyperlink URL of it's column "AD" cell. I am currently using this code:
do while....
NextToFill = Sheet2.Range("J1").End(xlDown).Offset(1).Address
On Error Resume Next
GetAddress = Sheet2.Range("AD" & Sheet2.Range(NextToFill).Row).Hyperlinks(1).Address
On Error GoTo 0
loop
Problem with the above code is it always get the address of the first hyperlink because the code is .Hyperlinks(1).Address. Is there anyway to get the hyperlink address by range address like maybe sheet1.range("AD32").Hyperlinks.Address?
This should work:
Dim r As Long, h As Hyperlink
For r = 1 To Range("AD1").End(xlDown).Row
For Each h In ActiveSheet.Hyperlinks
If Cells(r, "AD").Address = h.Range.Address Then
Cells(r, "J") = h.Address
End If
Next h
Next r
It's a bit confusing because Range.Address is totally different than Hyperlink.Address (which is your URL), declaring your types will help a lot. This is another case where putting "Option Explicit" at the top of modules would help.
Not sure why we make a big deal, the code is very simple
Sub ExtractURL()
Dim GetURL As String
For i = 3 To 500
If IsEmpty(Cells(i, 1)) = False Then
Sheets("Sheet2").Range("D" & i).Value =
Sheets("Sheet2").Range("A" & i).Hyperlinks(1).Address
End If
Next i
End Sub
My understanding from the comments is that you already have set the column J to a string of the URL. If so this simple script should do the job (It will hyperlink the cell to the address specified inside the cell, You can change the cell text if you wish by changing the textToDisplay option). If i misunderstood this and the string is in column AD simply work out the column number for AD and replace the following line:
fileLink = Cells(i, the number of column AD)
The script:
Sub AddHyperlink()
Dim fileLink As String
Application.ScreenUpdating = False
With ActiveSheet
lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
For i = 4 To lastrow
fileLink = Cells(i, 10)
.Hyperlinks.Add Anchor:=Cells(i, 10), _
Address:=fileLink, _
TextToDisplay:=fileLink
Next i
End With
Application.ScreenUpdating = True
End Sub
Try to run for each loop as below:
do while....
NextToFill = Sheet2.Range("J1").End(xlDown).Offset(1).Address
On Error Resume Next
**for each** lnk in Sheet2.Range("AD" & Sheet2.Range(NextToFill).Row).Hyperlinks
GetAddress=lnk.Address
next
On Error GoTo 0
loop
This IMO should be a function to return a string like so.
Public Sub TestHyperLink()
Dim CellRng As Range
Set CellRng = Range("B3")
Dim HyperLinkURLStr As String
HyperLinkURLStr = HyperLinkURLFromCell(CellRng)
Debug.Print HyperLinkURLStr
End Sub
Public Function HyperLinkURLFromCell(CellRng As Range) As String
HyperLinkURLFromCell = CStr(CellRng.Hyperlinks(1).Address)
End Function