I am trying to add 5 new worksheets in my vba code. Originally my code only required 1 sheet and now 6 sheets need to be present. Each have a unique name. I will have different lines of code throughout the code that need to be added to each worksheet.
Sheets(1).Name = "Make-Ready"
Worksheets.Add(After:=Sheets(1)).Name = "My New Worksheet"
Set MRBook = Worksheets("Make-Ready").Parent
There is a portion of the code that errors out when my variable MRBook is defined.
If (RDBook.Sheets("RawData").Cells(PoleRow - 12, "BZ").Value) = "No" Then MRBook.Sheets("Make-Ready").Range(Cells(PoleRow, 87), Cells(PoleRow, 88)).Style = "Bad"
The part that errors out is the MRBook.Sheets("Make-Ready"). Do you know which part of these two examples could be the issue?
I believe you are not qualifying Cells properly. By that I mean that in the Then line, the Cells keyword is not referring to the proper worksheet.
Cells (unqualified) references the active worksheet. So your program should work if Make-Ready happens to be the active worksheet.
In the code below, because of the With.. and the leading dot, Cells will reference Make-Ready no matter what worksheet is active.
Try:
With MRBook.Sheets("Make-Ready")
If (RDBook.Sheets("RawData").Cells(PoleRow - 12, "A").Value) = "No" Then .Range(.Cells(PoleRow, 87), .Cells(PoleRow, 88)).Style = "Bad"
End With
As pointed out by #EEM,
If (RDBook.Sheets("RawData").Cells(PoleRow - 12, "A").Value) = "No" Then Range(.Cells(PoleRow, 87), .Cells(PoleRow, 88)).Style = "Bad"
(no dot preceding Range) would also work since both arguments are qualified by the worksheet.
Related
I am learning VBA, and this forum has helped me many times already, checking previous questions and answers, however this time I can't manage to figure out what is happening, and can't find an existing solution that works.
So, I have two listboxs in a worksheet: LB_SelectTaskToDelete and LB_SelectLineToDelete. The purpose of the first lisbox is to allow the user select a task, that later I will use in a macro to find it and delete it in another sheet.
Each task can be linked to one or more "Lines" so the second listbox lets the user select what specific Line he wants to delete, for a chosen Task. The code here is on the LB_SelectTaskToDelete Change event, to fill the second listbox.
Before I was using LB_SelectTaskToDelete with only one column, and this worked like a charm:
For Each cell In rng
If [cell.Value = LB_SelectTaskToDelete.Value] And [activetask = "Y"] Then LB_SelectLineToDelete.AddItem cell.Offset(0, 3).Value
Next cell
But I wanted to give more info to the user adding a second column, and now I don't know how to make it work.
Currently looks like this, but I keep getting Type mismatch error.
If LB_SelectTaskToDelete.ListIndex > -1 And LB_SelectTaskToDelete.Selected(LB_SelectTaskToDelete.ListIndex) Then
For Each cell In rng
activetask = CStr(cell.Offset(0, -2).Value)
selectedTask = CStr(LB_SelectTaskToDelete.List(LB_SelectTaskToDelete.ListIndex, 0))
celltext = CStr(cell.Text)
If [celltext = selectedtask] Then MsgBox ("Works") ' Should be an And with the two statements
If [activetask = "Y"] Then MsgBox ("works too") 'LB_SelectLineToDelete.AddItem cell.Offset(0, 3).Value
Next cell
End If
The error appears on
If [celltext = selectedtask] Then
The text saved in the variables is like this: "PM001"
If both are strings, why the type mismatch?
The data I have in my "entity sheet"
entity id
source id
source entity id
HR0001
GOP
1200
HR0002
WSS
WSS1201
HR0003
GOP
1201
HR0004
WSS-T
WSST1202
HR0005
GOP
1202
HR0006
GOP
1203
HR0007
WSS-S
WSSS1203
HR0008
GOP
1204
HR0009
GOP
1205
HR0010
GOP
1206
HR0011
WSS-R
WSSR1204
HR0012
WSS-T
WSST1205
HR0013
WSS-S
WSSS1206
HR0014
GOP
1207
HR0015
WSS-T
WSSS1207
HR0006
WSS-S
WSSS1208
HR0007
GOP
1208
HR0008
WSS-R
WSST1209
HR0009
WSS-S
WSSS1210
In my working sheet, I need the source entity id (column c) data, by doing a VLOOKUP on the entity id (column A), based on source id (column b). that is I need only those beginning with "WS" IDs on my working sheet. My code is
Sub Test()
Worksheets("working sheet").Activate
Dim sht, sht1 As Worksheet
Dim i As Long, LR As Long
Set sht = ActiveWorkbook.Worksheets("working sheet")
Set sht1 = ActiveWorkbook.Worksheets("entity sheet")
LR = sht.UsedRange.Rows.Count
With sht
For i = 2 To LR
If InStr(sht1.Range("B" & i).Value, "WS") Then
sht.Range("B" & i).Value = (Application.VLookup(.Range("A" & i).Value, Worksheets("entity sheet").Range("A2:C5000"), 3, False))
End If
Next i
End With
End Sub
desired result - in the working sheet
entity id
source entity id - WSS
HR0001
HR0002
WSS1201
HR0003
HR0004
WSST1202
HR0005
HR0006
WSSS1208
HR0007
WSSS1203
HR0008
WSST1209
HR0009
WSSS1210
HR0010
HR0011
WSSR1204
HR0012
WSST1205
HR0013
WSSS1206
HR0014
HR0015
WSSS1207
Took me a little while but... I've got two different versions for you: one with VBA and one with just formulas.
With VBA
The issue you had was that VLOOKUP returns the first match but you needed to satisfy two criteria (that is: (i) match on entity id and (ii) match on source id begins with "WS").
This meant that you either had to:
use a formula that could match both criteria at the same time, OR
find all matches with the first criteria (e.g. with FIND) and then loop through the results to match the second criteria -- probably something like this: https://www.thespreadsheetguru.com/the-code-vault/2014/4/21/find-all-instances-with-vba
I selected option #1 as I expected it would make the code shorter.
To do this, I took advantage of a trick I've used in formulas before where I can use "&" between two ranges to match on two criteria at the same time. So, instead of matching "HR0012" first and then "WS-something" second, I match "HR0012WS-something" at once. (You can view this concept by pasting =A2:A20&B2:B20 in an empty column somewhere in your entity sheet.)
The following code assumes that your active worksheet is your working sheet. Paste this code behind your working sheet, then run it when you have that sheet open.
Public Sub tester()
Dim rg As Range
Dim sSourceEntityId As String
For Each rg In Range("A2:A16")
sSourceEntityId = Evaluate("=XLOOKUP(""" & rg.Value & "WS"",entity!A2:A20&LEFT(entity!B2:B20,2),entity!C2:C20,"""",0,1)")
If Len(sSourceEntityId) > 0 Then
rg.Offset(0, 1).Value = sSourceEntityId
End If
Next rg
End Sub
If the part inside the Evaluate is not clear, paste
=XLOOKUP(A1&"WS",entity!A2:A20&LEFT(entity!B2:B20,2),entity!C2:C20,"",0,1)
somewhere inside your working sheet to see it more clearly.
Also, note that you used Instr, which would find "WS" anywhere in the string. I used LEFT(value, 2)="WS" to be sure that I matched only the first 2 characters.
I also had to use XLOOKUP instead of VLOOKUP to allow me to use the LEFT(value, 2). If you're using an old version of Excel, you won't have XLOOKUP, unfortunately.
Without VBA
Paste this formula into A2 on your working sheet:
=IFERROR(INDEX(entity!$C$2:$C$20,AGGREGATE(15,3,((entity!$A$2:$A$20&LEFT(entity!$B$2:$B$20,2)=A2&"WS")/(entity!$A$2:$A$20&LEFT(entity!$B$2:$B$20,2)=A2&"WS"))*ROW(entity!$A$2:$A$20)-ROW(entity!$A$1),1)),"")
Then copy that formula down to every row that you want to do a match on. Just to be clearer, it will look like this:
This is a little complex. I based it on an approach in this article, which explains step-by-step how to use INDEX(.. AGGREGATE(..)) for multiple matches. Although it's pretty neat how it works, you may prefer the VBA approach as it is probably easier to maintain.
UPDATE:
I forgot to mention that there is a possibility that the IFERROR() in the formula may slow your spreadsheet down if you have many matches and rows. I also created a version of the formula that doesn't use IFERROR. It uses an IF to first check if there are any TRUE matches first before executing the INDEX.. AGGREGATE. You may not need it, but I've pasted it below just in case it's useful:
=IF(MAX(INT(entity!$A$2:$A$20&LEFT(entity!$B$2:$B$20,2)=A2&"WS"))=1,INDEX(entity!$C$2:$C$20,AGGREGATE(15,3,((entity!$A$2:$A$20&LEFT(entity!$B$2:$B$20,2)=A2&"WS")/(entity!$A$2:$A$20&LEFT(entity!$B$2:$B$20,2)=A2&"WS"))*ROW(entity!$A$2:$A$20)-ROW(entity!$A$1),1)),"")
UPDATE 2:
The statement used in the VBA Evaluate will also work directly as a formula and is much simpler to understand. I realized this when I realized that a single valid match is okay (i.e. we don't need multiple matches):
=XLOOKUP(A2&"WS",entity!$A$2:$A$20&LEFT(entity!$B$2:$B$20,2),entity!$C$2:$C$20,"",0,1)
I am enhancing a work template that requires users to create a new file each week to be able to track progress from week to week, so the file will change name each week.
This file has about 3 charts in a "Summary" worksheet.
In this "Summary" worksheet, bar chart #2 currently has 5 series. I am writing a script to be able to add a 6th series.... this I have no problem.
I would like the new Series values to use the values from a Name Range of cells the template currently has defined ("software") in a different worksheet.
I would also like the Horizontal Axis Labels to use a different Name Range of cells that template also has defined ("dates") in a different worksheet.
Here is the code I have so far:
Sub add_software()
'Update software Trend in Summary
Sheets("Summary").SelectActiveSheet.ChartObjects("Chart 2").Activate
ActiveChart.SeriesCollection.NewSeriesActiveChart.FullSeriesCollection(6).Name = "='Summary'!$C$44"
'MY PROBLEM IS HERE
ActiveChart.FullSeriesCollection(6).Value = ActiveWorkbook.Sheets("Summary").Range("Software")
ActiveChart.FullSeriesCollection(6).XValues = ActiveWorkbook.Sheets("Summary").Range("dates")
End sub
I would expect that the script will use the values in these Name Ranges (which are the same values used in the other 5 series) and populate with the values from the name range.
This is the error I get is:
Run-Time error '438': Object doesn't support this property or method
error
Try this other method to get the range. Not tested but it should work.
ActiveChart.FullSeriesCollection(6).Value = ThisWorkbook.Names("Software").RefersToRange
ActiveChart.FullSeriesCollection(6).XValues = ThisWorkbook.Names("dates").RefersToRange
Edit: Had an extra dot after "Names".
The accepted solution by #RicardoA works fine, but it assumes a static definition of the names, and places the current address of each name into the SERIES formula of the series. If the names are dynamic, the SERIES formula will not keep up with the changes. The following puts the names not addresses of the names into the series formula:
ActiveChart.SeriesCollection(6).XValues = "='" & ThisWorkbook.Name & "'!dates"
ActiveChart.SeriesCollection(6).Values = "='" & ThisWorkbook.Name & "'!software"
u have a typo. u have miss a "
where u have
.Range("Software)
replace to
.Range("Software")
good luck
This has been asked already, but none of the answers available helps me. I am trying to add a row to a small worksheet. I am allowed to add the row with Alt-I, R manually, but if I try to do it from a macro, I get this:
I have tried, without effect, the following suggestions I have found on the Internet:
Check that data isn’t ridiculously long. Ctrl-End takes me to G40. The last available row is 1048576.
Unfreeze panes.
Execute “ActiveSheet.UsedRange” in the Immediate window.
Unmerge cells in row above the one I was inserting.
Rows("1048500:1048576").Delete. This ought to free up 76 rows, yet immediately after it attempting to insert just one row is forbidden.
Application.CutCopyMode = False
Selecting all the rows below those used and choosing “Clear Content”, save, close and reopen.
I am using Excel 2016. The only solution that looks at all plausible is using Application.SendKeys to do Alt-I, R, but I would rather not do that if I can help it. Neither the sheet nor the workbook containing it is protected. If you want to know what the offending code is:
For iWorksheetCounter = 2 To wbkFinal.Worksheets.Count
Set wksPartial = wbkFinal.Worksheets(iWorksheetCounter)
lngCurrentRow = iWorksheetCounter + iRowOffset ' iRowOffset = 3
wksTotals.Rows.Insert (lngCurrentRow + 1) ' this is not allowed for a reason I don't understand
wksTotals.Cells(lngCurrentRow, 1).Value = wksPartial.Name
Next ' iWorksheetCounter
I have recently migrated to pclinuxos from windows and seem to like it. The only problem I am facing is that libreoffice, the default spreadsheet package is not compatible with excel macros. Below is the vba code I have:
Option VBASupport
Sub DeleteToLeft()
Selection.SpecialCells(xlBlanks).Delete shift:=xlToLeft
End Sub
Function SinceLastWash()
Application.Volatile
WashCount = 0
WearCount = 0
CurrentRow = Application.ThisCell.Row
For i = 3 To 35
If Range(Cells(CurrentRow, i), Cells(CurrentRow, i)).Value = "a" Then
WearCount = WearCount + 1
End If
If Range(Cells(CurrentRow, i), Cells(CurrentRow, i)).Value = "q" Then
WashCount = WashCount + 1
WearCount = 0
End If
Next i
SinceLastWash = WearCount
End Function
Function testhis()
testhis = Application.ThisCell.Row
End Function
Is there a way to convert this code to make it compatible with libreoffice or do I have to learn an altogether new language like python? Learning python would not be a problem but is not a solution to my problem as I have many work related files in excel which have a lot of vba code and it is not possible for me to use open office/libreoffice at work...
I just want to add that the function SinceLastWash gives the correct value in some cells where I use it and in others gives an error, #NAME?
Thanks
From LibreOffice's online help file:
With a few exceptions, Microsoft Office and LibreOffice cannot run the same macro code. Microsoft Office uses VBA (Visual Basic for Applications) code, and LibreOffice uses Basic code based on the LibreOffice API (Application Program Interface) environment. Although the programming language is the same, the objects and methods are different.
The most recent versions of LibreOffice can run some Excel Visual Basic scripts if you enable this feature at LibreOffice - PreferencesTools - Options - Load/Save - VBA Properties.
In reality, you would most likely need to sit down with the LibreOffice API and rewrite the functionality.
You must translate the portions that manipulate the document to use the UNO API. Sadly, this can be tricky depending on what your macro does. Basic statements work directly. Modifying a document generally does not.
Range(Cells(CurrentRow, i), Cells(CurrentRow, i)).Value = "a"
The Cells command returns a specific cell based on a row and column. So, you need the current row. Here is some craziness to get the active cell:
Sub RetrieveTheActiveCell()
Dim oOldSelection 'The original selection of cell ranges
Dim oRanges 'A blank range created by the document
Dim oActiveCell 'The current active cell
Dim oConv 'The cell address conversion service
Dim oDoc
oDoc = ThisComponent
REM store the current selection
oOldSelection = oDoc.CurrentSelection
REM Create an empty SheetCellRanges service and then select it.
REM This leaves ONLY the active cell selected.
oRanges = oDoc.createInstance("com.sun.star.sheet.SheetCellRanges")
oDoc.CurrentController.Select(oRanges)
REM Get the active cell!
oActiveCell = oDoc.CurrentSelection
oConv = oDoc.createInstance("com.sun.star.table.CellAddressConversion")
oConv.Address = oActiveCell.getCellAddress
Print oConv.UserInterfaceRepresentation
print oConv.PersistentRepresentation
REM Restore the old selection, but lose the previously active cell
oDoc.CurrentController.Select(oOldSelection)
End Sub
When you have the active cell, you get the cell address, and from that, you have the row. You do not need to use the range at all, since you only care about a single cell, so, you get the active sheet and then get a particular cell from the sheet.
Something like this:
ThisComponent.getCurrentController().getActiveSheet().getCellByPosition(nCol, nRow).getString() = "a"
I don't feel like figuring out what this does
Selection.SpecialCells(xlBlanks).Delete shift:=xlToLeft
In LibreOffice 4.4, the first subroutine will not work at all (I suspect due to all the variables beginning with 'xl'. The other two work perfectly if you change ThisCell to ActiveCell.
Rather than
Option VBASupport
I am using
Option VBASupport 1
Option Compatible
The only automatic tool I'm aware of is Business Spreadsheets (note that I have no personal or professional experience nor any affiliation with the site).
It seems specific to OpenOffice but I think it works with LibreOffice too.
In general though, you're better off doing this yourself, as the tool is far from perfect...
Selection.SpecialCells(xlBlanks).Delete shift:=xlToLeft deletes blank cells if I'm not mistaken