I am using VBA to help manage a set of data. I will have Monthly Data for 50 months and I wish to categorize it into different sheets based on the FIRST word within a cell. Here is what I done so far;
I created a workbook with 2 sheets,
Sheet1(Employee Inventory)
Sheet2(PB)
and my code is written and saved in this Workbook.
Sub myCode()
Dim OldString As String
Dim NewString As String
Set i = Sheets("Employee Inventory")
Set PB = Sheets("PB")
Dim counterPB
counterPB = 2
Dim d
Dim j
d = 1
j = 2
Do Until IsEmpty(i.Range("D" & j))
OldString = i.Range("D" & j)
NewString = Left(OldString, 2)
If NewString = "PB" Then
i.Rows(j).EntireRow.Copy
PB.Range("A" & counterPB).Select
PB.Paste
counterPB = counterPB + 1
End If
j = j + 1
Loop
End Sub
Apologies for the code as it looks weird. This code looks at Sheet1 and scans column "D" and looks for the first word starting with "PB". Once it does find it, it will copy and paste the whole row into another sheet called Sheet2(PB).
When I am in Microsoft Visual Basic window AND I have the Excel Spreadsheet with Sheet1(Employee Inventory) tab opened and when I click Run Sub I get the following error: Run-time error '1004': Application-defined or object-defined error. When I click on "PB" tab, nothing is being copy and pasted in there.
HOWEVER, when I click on the PB tab and then I click Run Sub, the codes executes and any rows containing the first word "PB" will be copied and pasted in the "PB" tab.
My question is, why does it only work when I have the Sheet2 opened and not when I have Sheet1 Opened?
when use range.select its parent worksheet must be selected, so we can use PB.Activate or not use .select at all.
Try to replace this:
i.Rows(j).EntireRow.Copy
PB.Range("A" & counterPB).Select
PB.Paste
with this line:
i.Rows(j).Copy PB.Rows(counterPB)
Why don't you just select the second sheet at the beginning of the code?
Try the following
ActiveWorkbook.Sheets("Sheet2").Activate
If it really works when this sheet is selected, then it should work with this.
Related
I'm using three Workbooks. My Current workbook, The database workbook (DB_Wkb), the Document to change ( Doc_Wkb) and my current macro file.
I'm using vLookup to compare the ID, and get the name from the database The problem is that it works fine, but it takes a lot of time and Excel stops responding. I believe the use of vlookup is what makes my macro to take so long.
Dim Doc_Wkb As Workbook 'Document
Dim DB_Wkb As Workbook 'Database
Set Doc_Wkb = Workbooks.Open(Doc_Path)
Doc_Wkb.Worksheets(Sheet_Name).Cells.Select 'sheet_name=Sheet of the Document
Selection.UnMerge
Doc_Wkb.Worksheets(Sheet_Name).Range("A5:S" & Cells(Rows.Count, "S").End(xlUp).Row).RemoveDuplicates Columns:=16, Header:=xlYes
Set DB_Wkb = Workbooks.Open(DB_Path)
Dim Str As String
Dim Cont_Doc As Double
P = 6 ' P Declared in Module
Cont_DB = DB_Wkb.Worksheets(Sheet_name_2).Range("B:F") ' Sheet_name_2 = sheetname of DB
While Not IsEmpty(Doc_Wkb.Worksheets(Sheet_Name).Cells(P, 5))
Cont_Doc = Doc_Wkb.Worksheets(Sheet_Name).Cells(P, 5)
store = Application.VLookup(Cont_Doc, Cont_DB, 5, False)
Doc_Wkb.Worksheets(Sheet_Name).Cells(P, 20) = store
P = P + 1
Wend
Thank you so much for your help.
Update: I figured out an alternative. Using DoEvents solves this problem. Meanwhile a progress bar can be used for the looks.
I'm new to this site, but I have already found some nice advice on how to solve problems in VBA. Now I'm here to ask help on a sub that gives me problems with Hyperlinks.
In particular, my problem is similar to the one described in this topic:
Excel VBA Get hyperlink address of specific cell
I have a worksheet full of hyperlink, but I need to extract only the addresses present in the "H" column, starting from "H6" and writing them into the "N" column, starting from "N6".
I put down this code:
Sub EstraiIndirizzoPut()
Dim IndirizzoInternet As Hyperlink
Dim ISINs As String
i = 6
For Each IndirizzoInternet In Sheets("XXX").Range("H" & i).Hyperlinks
IndirizzoInternet.Range.Offset(0, 6).Value = IndirizzoInternet.Address
ISINs = Mid(IndirizzoInternet.Address, 78, 12)
Range("N" & i).Value = ISINs
i = i + 1
Next
End Sub
It works fine only for the first "H6" cell, but at the "Next" point, when it should read the "H7" cell, it goes instead to "End Sub", terminating the routine, altough the "H7" cell, as well many others down the column, are filled with hyperlinks (it gives me "Nothing" value).
Could you please suggest me where I get this wrong? Many thanks.
Your loop isnt set up correctly. Try it like this instead:
For i = 6 to 100
Set IndirizzoInternet = Sheets("XXX").Range("H" & i).Hyperlinks
IndirizzoInternet.Range.Offset(0, 6).Value = IndirizzoInternet.Address
ISINs = Mid(IndirizzoInternet.Address, 78, 12)
Range("N" & i).Value = ISINs
Next
How do you know when to stop the loop? Is it a preset number of rows? If it not, you will want to have something determine the last row to process and replace the 100 with that variable.
Y helo thar,
actually my vba-knowledge is quite good and normally I don't have many difficulties coding , but this is driving me nuts.
Code is pretty easy. I have a worksheet PR_DB where all my projects are stored. For every project there are a number of employees, saved in cells (sel_pr, >10+) (employee name and ID).
I want to delete an employee from the project and tidy up the project database entry. All employees are listed in two listboxes. The ones that are working in the project, and the ones that don't. Via the buttons I can add and remove employees from either listbox.
When I add an employee to a project (top button), my Sub just puts the ID&Name at the end of the row of said project.
When I remove them from a project and therefore from the database, I look for the cell with the employee data. Afterwards I just want to cut all the cells to the right and paste them one cell to the left (via offset) so the deleted name is overwritten.
This is my code:
Sub delMA_from_prBetList()
Dim i, j, k, listRow, lastRowMA_DB, lastRowPR_DB, sel_pr As Integer
Dim wsPR, wsMA_DB, wsPR_DB As Worksheet
Dim foundMA As Boolean
Dim cutRng, pasteRng As Range
Set wsPR = Worksheets("Projekte")
Set wsMA_DB = Worksheets("MA_DB")
Set wsPR_DB = Worksheets("PR_DB")
lastRowPR_DB = wsPR_DB.UsedRange.Rows.Count
'check if any employee was selected
If IsNull(wsPR.prBetListe.Value) = True Then
MsgBox "Please select an employee."
Exit Sub
End If
j = 10
'look for selected project in DB
For i = 2 To lastRowPR_DB
If wsPR_DB.Cells(i, 1) = CInt(wsPR.prListe.Value) Then
'row ID of said project
sel_pr = i
End If
Next
'find employee
Do Until wsPR_DB.Cells(sel_pr, j) = ""
'employees are saved as "ID;NAME"
If wsPR_DB.Cells(sel_pr, j) = wsPR.prBetListe.Value & ";" & wsPR.prBetListe.Column(1, wsPR.prBetListe.ListIndex) Then
'when found, look for last cell with an entry
k = j
Do Until wsPR_DB.Cells(sel_pr, k) = ""
k = k + 1
Loop
'set cutRng so it spans from cell right to the found employee
'to last cell with an employee in that project
Set cutRng = wsPR_DB.Range(wsPR_DB.Cells(sel_pr, j + 1), wsPR_DB.Cells(sel_pr, k))
'set pasteRng like cutRng, just one cell further to the left
'so the deleted employee will be overwritten
Set pasteRng = cutRng.Offset(rowOffset:=0, columnOffset:=-1)
cutRng.Cut
pasteRng.PasteSpecial
Exit Do
End If
j = j + 1
Loop
're-initialize listboxes
Call init_maListe_dyn
Call init_prBetListe_dyn
End Sub
So whats the problem? Everything works just fine, all the cells I want to cut go into clipboard, but they arent pasted into the pasteRng. Error is
Error 1004 "Application-defined or Object-defined error". I tried a thousand things but the solution is probably too easy to find.
Hope you can help me, thanks in advance.
PS: I'm kind of in a hurry, so that text might not be as well formatted as it could be. Please bear with me.
just use directly:
cutRng.Cut pasteRng
this should solve your problem ;)
If you want to offset one column to the left it should be
Set pasteRng = cutRng.Offset(,-1)
Also, you're not defining how you want to paste. The paste settings may not be set to paste values if they were set differently prior to this instance (via code or otherwise). If you want to just cut-paste the values it would be
cutRng.Cut
pasteRng.PasteSpecial xlPasteValues
Let me know if that helps at all and if not I'll look further into it.
This is my first question, so sorry for terminology.
I'm beginner in VBA, so I'm stopped in few questions.
I'm working in Powerpoint. I have combobox and I want to add items from table (it could be as table, or Excel spreadSheet) which is on previous slide.
I found one example for Excel (I don't know if will work in PPT):
Sub Loadbox()
row_review = 1
Dim TheSheet As ?????
Set TheSheet = ?????
Do
DoEvents
row_review = row_review + 1
item_in_review = TheSheet.Range("A" & row_review)
If Len(item_inreview) > 0 Then ComboBox1.AddItem (item_in_review)
Loop Until item_in_review = ""
End Sub
But I couldn't understand how to define table from witch I get data for item.
Maybe there is better way how to do it?
To read the contents of the first cells of a row in a PowerPoint table this is the starting point.
Dim tbl As Table
Dim i As Long
Set tbl = ActivePresentation.Slides(1).Shapes(2).Table
For i = 1 To tbl.Rows.Count
Debug.Print tbl.Cell(i, 1).Shape.TextFrame2.TextRange.Text
Next
I am writing a piece of code that transfers selected data on an Excel sheet into an array, which is then used to print the data on a new spreadsheet. However, I am getting a "Subscript Out of Range" error, even though a value appears when I scroll over selectArr(i - 1). Here is my code:
Sub Marascuilo()
Dim numRows As Integer 'Number of rows selected
numRows = Selection.Rows.Count
Dim selectArr() As Double 'Array containing numbers from selected cells
selectArr = loadArr(numRows) 'Load values into array
For i = 2 To UBound(selectArr) - LBound(selectArr) + 2
Sheets("Sheet 4").Cells(i, 2).Value = selectArr(i - 1)
Next
End Sub
'This function loads the values from the selected cells into selectArr.
Function loadArr(numRows) As Double()
Dim ResultArray() As Double
r = 1
For Each v In Selection
ReDim Preserve ResultArray(1 To r)
If v <> "" Then
ResultArray(r) = v.Value
r = r + 1
End If
Next
loadArr = ResultArray
End Function
Any ideas as to how I fix this issue?
Thanks!
Jay
Instead of using Sheets("Sheet 4"), you might consider using the sheet's CodeName. If you look in the Project Explorer window, every sheet has a Name and a CodeName. It might look like this
Sheet1 (Sheet1)
Sheet2 (Sheet2)
The first one is the CodeName (can't be changed from the UI). The one in parens is the tab name. Select the sheet in the Project Explorer and press F4 to open the Properties dialog. Go to the (Name) property (a poorly named property) and change it to something meaningful. I change all my sheets' CodeNames and use a wsh prefix. My sheet that's a log has a CodeName of
wshLog
Now I can use wshLog in my code and I get some benefits. The first is that if someone renames the sheet in the UI, the code still works. The second is I can type wshlog (all lower case) and the VBE will change it to wshLog and I get that visual cue that I spelled it right. Finally, my code is more readable, ex wshFinalReport vs. Sheets("Sheet1").