Count IF on multiple sheets, VBA - excel

If Application.CountIf(Sheet5.Range("A:A"), TextBox1.Value) = 0 Then
GoTo 10
Else....
This code checks if there is already a value from Textbox1 somewhere in A column(a list of values).
Now I want to transform the code so it checks existence of a value(from textbox1) in multiple sheets(growing), but only in one cell from every sheet(say: A1).
Can this be done with count if somehow? I dont want to use Loops (for, with..) takes to long on few hundreds of sheets

See the below:
For Each ws In ThisWorkbook.Worksheets
formula = formula & "," & ws.Name & "!A1"
Next ws
formula = "=COUNTIF({" & Mid(formula, 2) & "}, TextBox1.Value)"
If Application.Evaluate(formula) = 0 Then
GoTo 10
Else....

Without looping (and the use of ms365's TOCOL()), you could use 3D-referencing. But make sure your range of worksheets are connected. For example:
Debug.Print Application.Evaluate("SUM(N(TOCOL(Sheet1:Sheet100!A1,3)=" & TextBox1.Value & "))")
This is very much so like this older post, but TOCOL() makes life easier, plus you won't run into the limits of the Evaluate() method.
Note that if you have a growing number of sheets, you could also opt for:
Debug.Print Application.Evaluate("SUM(N(TOCOL(Sheet1:Sheet" & Application.Sheets.Count & "!A1,3)=" & TextBox1.Value & "))")

Related

Excel VBA macro reading one column with differing text

I was tasked with creating a code that will check to see if internal hyperlinks in an excel spreadsheet worked. This code first changes the formulas that were on the spreadsheet and makes them actual hyperlinks (they were originally formulas linking the locations together). The problem that I have now is that I want to create hyperlinks ONLY if Column S has text. If it doesn't, I don't want the "E-COPY" text to be displayed. All of the text in Column S varies (not one line has the same characters), which is why I'm drawing a blank is to how I tell the program to only continue if it has any text, not anything specific. I am working with Excel 2016.
Also, I am doing this to 71935 and counting rows; is there a limit to how many it can go through? If so, what can I do about it?
Thank you!
Sub CreateHyperlinks()
Dim FN As Variant
Dim Path As Variant
Dim count As Variant
Sheets(1).Activate
count = WorksheetFunction.CountA(Sheets(1).Range("A:A"))
For i = 2 To count
If Range("AM" & i).Value = "Yes" And Columns("S") = Then
Range("E" & i).Value = ""
Path = Sheets(1).Range("R" & i).Value
FN = Sheets(1).Range("S" & i).Value
Sheets(1).Range("E" & i).Select
Selection.ClearFormats
Selection.Hyperlinks.Add Anchor:=Selection, Address:=Path & FN, TextToDisplay:="E-COPY"
Range("AM" & i).Value = " "
End If
Next i
End Sub
If you just need to check for any content in ColS then:
If Range("AM" & i).Value = "Yes" And Len(Range("S" & i).Value) > 0 Then
Few things:
'make a reference to the sheet you're working with
Dim ws As Worksheet
Dim wb As Workbook
Set wb = Excel.Application.ThisWorkbook
Set ws = wb.Worksheets(1)
'gets the absolute last row with data in it // ignores empty cells
count = ws.UsedRange.Rows.Count
personally, i hate working with named ranges, so i would suggest setting range references like so
what you wrote
Path = Sheets(1).Range("R" & i).Value
what i believe it should look like
Path = ws.Cells(i, 18).Value
if you want to test the type when working with variants, try this:
'tests the type associated with the variant. an 8 = string
If VarType(ws.Cells(i, 19).Value) = 8 Then
'do your thing
'tests if the value is null
ElseIf VarType(ws.Cells(i, 19).Value) = 0 Then
'do your other thing
here's a list of the vartype enumeration to help you out.
hope it helps!

Excel-VBA string manipulation issue

I am trying to copy some 8-digit numbers to use in a SQL search.
The SQL query gave me errors and after some debugging I found that the string doesn't contain all the data. It seems that after 25 or so numbers my for loop stops entering data as if the string is full.
Thanks for the help...
Lots = ""
For iRow = 2 To 500
If IsEmpty(Sheets("Filtered Data").Cells(iRow, 2)) Then Exit For
Lots = Lots & ",'" & Sheets("Filtered Data").Cells(iRow, 2).value & "'"
Next iRow
Lots = "(" & Mid(Lots, 2, Len(Lots) - 1) & ")"
you should post your data raising the errors
as for while you can consider the following code to build-up the string exploiting Join() function
Dim Lots As String
With Worksheets("Filtered Data") '<--| change "Filtered Data" with your actual worksheet name
With .Range("B2", .Cells(.Rows.Count, 2).End(xlUp)) '<-- consider its column "B" cells from row 2 down to last non empty one
Lots = "('" & Join(Application.Transpose(.Value), "','") & "')" '<-- build up the string
End With
End With
this assumes that all non empty cells in column "B" are contiguous (i.e. non blank cells in between non blank ones), but it can be easily modified should this not be the case
Your code works fine. Presumably you have an empty cell in the column which is making it exit the loop....

Using WorksheetFunction.Match on a non ordered list and not exact

I have two workbooks, and both shave a list of ALMOST the same items. One of the list has a few extra spaces at the end of its list and it's throwing me completely off.
Public Sub test() 'Imports data into M&R spreadsheet
Dim wbMnR As Workbook
Dim wbMatch As Workbook
Set wbMnR = Workbooks("MnRs.xlsx")
Set wbMatch = Workbooks("Match.xlsm")
Dim myRow As Integer
For i = 1 To 10
myRow = WorksheetFunction.Match(wbMatch.Worksheets(1).Range("a" & CStr(i)), wbMnR.Worksheets(1).Range("A:A"), 0)
Debug.Print myRow
Next i
End Sub
The item list in copy is
"R-01"
"R-02"
"R-03"
"R-04"
the item list in paste is
"R-01 "
"R-03"
"R-02"
"R-04 "
These are just examples I made up and for various reasons I can't input my actual data. I cannot sort my list in the MnR worksheet though since the workbook I was given contains some merge cells and various data which separates specific sections. With the way Match works, I know that using a perfect match of "0" will not work because of the extra space, but using a "1" or "-1" will not work either because my list cannot be sorted.
Try this Select Case statement.
With wbMatch.Worksheets(1)
For i = 1 To 10
myRow = 0
Select Case False
Case IsError(Application.Match(.Range("a" & i), wbMnR.Worksheets(1).Range("A:A"), 0))
myRow = Application.Match(.Range("a" & i), wbMnR.Worksheets(1).Range("A:A"), 0)
Case IsError(Application.Match(.Range("a" & i) & Chr(32), wbMnR.Worksheets(1).Range("A:A"), 0))
myRow = Application.Match(.Range("a" & i) & Chr(32), wbMnR.Worksheets(1).Range("A:A"), 0)
Case Else
'nothing found
End Select
Debug.Print myRow
Next i
End With
If you run into further trouble, that Select Case will be easier to expand upon. To make this more efficient, the most common matches should be at the top of the Case statements.

Translate a worksheet formula in VBA

Can somebody help me to write this formula in excel VBA?
=IF(ISERROR(VLOOKUP(A3,Temp!$A$3:$A$595,1,FALSE)),A3,"0")
My code is getting stuck with :"syntax error"
Sub checkDuplitems()
Application.ScreenUpdating = False
Const top As Integer = 3
Dim bottom As Long
bottom = Sheets("Temp").Cells(Rows.Count, top).End(xlUp).row
With ThisWorkbook.Sheets("trash").Range("A" & top & ":A" & bottom)
.Formula = "=IF(ISERROR(VLOOKUP(A" & top & ",Temp!$B$" & top & ":$B$" & bottom & _
",1,FALSE)),A" & top & ", & '" 0" & ," '")"
.Value = .Value
.SortSpecial
End With
'Call something...
End Sub
You have a concatenation problem in the second line of the .Formula line.
To emulate the formula you have at the top of your question (which is wrong incidentally because you should be pointing to $B$3:$B$595 or something like that because your look up cell A3 should not be inside the VLOOKUP range).
Try this new .Formula line:-
.Formula = "=IF(ISERROR(VLOOKUP(A" & top & ",Temp!$B$" & top & ":$B$" & bottom & _
",1,FALSE)),A" & top & ", " & "0)"
Are you sure you want to use top as both the starting row in column A and the column to get the bottom row from the Temp worksheet? The important column on the Temp worksheet is column B (i.e. 2) not C (i.e. 3).
If you are putting formula(s) into Trash!A3:A595 that reference Trash!A3:A595 then these are circular references and cannot be resolved under normal conditions. I'll put the formulas into column Z.
If you are operating with Excel 2007 or newer then I would humbly propose this alternate that uses the worksheet's IFERROR function and does not attempt to make text out of the 0 returned value.
Const top As Integer = 3
Dim bottom As Long
bottom = Sheets("Temp").Cells(Rows.Count, "B").End(xlUp).Row '<~~change here
With ThisWorkbook.Sheets("trash")
With .Range("Z" & top, .Cells(Rows.Count, "A").End(xlUp).Offset(0, 25))
.Formula = "=IFERROR(VLOOKUP(A" & top & ", Temp!$B$" & top & ":$B$" & bottom & _
", 1, FALSE), 0)" '<~~ big change here
.Value = .Value
End With
End With
It is also curious as to why the number of rows of formulas in the Trash worksheet must be governed by the number of rows of data in the Temp worksheet. I would have thought that the number of values in column A of the Trash sheet should govern how many formulas go into the Trash worksheet.

Excel Macro - Dynamically Set Print Area

I have a table with a fixed number of columns, but the number of rows vary week on week.
Is there a macro I can create to set the print area automatically of this table?
I would combine a dynamically resizing named range with a VBA method.
First create a named range, MyNamedRange: (Assuming your table begins at $A$1 and your table has headers)
=OFFSET(A1,0,0,COUNTA(A:A)-1,COUNTA(1:1))
Then just execute a line of VBA:
ActiveSheet.PageSetup.PrintArea = "MyNamedRange"
Just use this simple code:
Private Sub prnt()
On Error Resume Next
Cells(1, 1).Select
With ActiveSheet.PageSetup
.PrintArea = Range(ActiveCell, ActiveCell.SpecialCells(xlCellTypeLastCell)).Select.Address
.Orientation = xlLandscape
.LeftHeader = "&p/&N"
.LeftFooter = ActiveWorkbook.FullName 'to show address
.PrintTitleRows = "$1:$5" 'repeat at top
.Zoom = False
.Orientation = xlLandscape
.FitToPagesWide = 1 'to print in 01 page
.FitToPagesTall = False 'to print in 01 page
End With
End Sub
If you're wanting to print the whole sheet always, you can actually just clear the print area and it will default to the amount of the sheet that is filled with data. If you're wanting not to hide some columns, wtfsven's answer is perfect.
I guess this is a pretty late response...
The solution above didn't work for me in Excel 2007 so I used
begin_column = 1
end_column = 5
begin_row = 1
end_row = 30
'converting the numbers to uppercase letters
temp_begin_column = Chr(first_column + 64)
temp_end_column = Chr(second_column + 64)
ActiveSheet.PageSetup.PrintArea = "$" & temp_begin_column & "$" & begin_row & ":$" & temp_end_column & "$" & end_row
This may seem like a complicated solution but its the only thing that reliably worked for me
I have tried this and it Worked for me.
StartColumn="A"
StartRow=1
EndColumn="B"
EndRow=10
ActiveSheet.PageSetup.PrintArea = StartColumn & StartRow & ":" & EndColumn & EndRow
ActiveSheet.PageSetup.PrintArea = "A1:B10"
Or
ActiveSheet.PageSetup.PrintArea = "$" & StartColumn & "$" & StartRow & ":" & "$" & EndColumn & "$" & EndRow
ActiveSheet.PageSetup.PrintArea = "$A$1:$B$10"
ActiveSheet.PageSetup.PrintArea = "MyNamedRange" as proposed above by Stephen Collins does not work for me.
But if I typed a slightly modified version:
ActiveSheet.PageSetup.PrintArea = MyNamedRange.Address then it works perfectly in my context.
I had Application.ReferenceStyle = xlR1C1 activated and not xlA1.
Note: ActiveSheet.PageSetup.PrintArea = MyNamedRange.Address(ReferenceStyle:=xlR1C1) would not work for me.
Similarly,
ActiveSheet.PageSetup.PrintArea = StartColumn & StartRow & ":" & EndColumn & EndRow as proposed above by Bhanu Pratap works indeed very well, 1st time. Bu not so easy to manage programmatically (column letters).
But using "R" & StartRow & "C" & StartColumn & ":" & "R" & EndRow & "C" & EndColumn --- does not work for me either. So, consistent.
Looking at https://learn.microsoft.com/en-us/office/vba/api/excel.pagesetup.printarea
it states that "you use the Address property to return an A1-style address."
So, it seems to be an expected VBA behaviour not to use xlR1C1 while it would be much easier to use programmatically.
My simple way around it:
Set MyNamedRange = Worksheets(i_sheet_idx).Range(Cells(StartRow, StartColumn), Cells(EndRow, EndColumn)) -- using the same variables as suggested above by Bhanu Pratap.
Then
ActiveSheet.PageSetup.PrintArea = MyNameRange.Address ' which does the job for me.
So, I can programmatically play with the start/End Row/Columns easily.
Using offset as suggested above should work also to change the range but this is independent from the programmatic difficulty encountered here in VBA to specify the range address in a way VBA would accept to swallow without error. I would not want to count the strange & unclear VBA errors I had on these trials. I don't use VBA often & never program otherwise (hence the struggle above). The goal was to print automatically, smartly & recurrently a large number of parts of a large worksheet following a pattern.
NB: possibly unrelated, I encountered in the debugging phase - just on the PageSetup.PrintArea line - as above a strange phenomenon where even if no error (so the code following later after rerun a fully expected & controlled path), my code would jump - sometimes - to a totally different sub or function in another workbook without reason (I have another personal workbook storing a number of work macros in several modules). It happens 4 times in tests. I tried to find events that could trigger this but could not find one. Sometimes it was the same sub/function being triggered, sometimes it was a different one, with no logical connection. But I noted that I had seen the same function being triggered in another situation before (see its basic code below), without good reason. So, something must happen at application level. In this "short piece of code" just written to test the above, I introduced later an error handler to catch err.number in case a problem would occur but of course, it did not reoccur.
I suppose that closing & restarting Excel (2013 here) should fix this error. This has happened to me before once in Excel 2010. A pointer going nuts but with some insistence, a repeated folly which supposes some logic behind. Weird.
Here is the function most often triggered in another module in another workbook (while not being programmatically activated at all, I repeat): it does not make logical sense to me but so it is:
Function HLink(rng As Range) As String
'extract URL from hyperlink
If rng(1).Hyperlinks.Count Then HLink = rng.Hyperlinks(1).Address
End Function
The other sub being activated did not make more apparent sense.

Resources