Cool... that works too
Posts by Ger Plante
Welcome to the forum BD....
Did you post this question somewhere else?If so please link to the other threads that you have started on other websites
Also, your thread title should describe the problem you are trying to solve and not specify you are in over your head. This helps other people when they are searching for solutions to similar type problems. I have updated the thread title now.
For fast turnaround projects, with guaranteed solutions you should consider the hire help forum here...
Anyway, without seeing your workbook and data - then the scenario you described is covered by the following code. It should get you started.Code
Option Explicit Public Sub Summarize() Dim r As Range Dim r2 As Range Dim ws As Worksheet Dim wsSummary As Worksheet On Error Resume Next Application.DisplayAlerts = False Worksheets("Summary").Delete: Set wsSummary = Worksheets.Add: wsSummary.Name = "Summary" For Each ws In ThisWorkbook.Worksheets If LCase(ws.Name) <> "summary" Then ws.Cells.AutoFilter Set r = ws.Range("A1:E50") r.AutoFilter 5, ">0" 'filter column 5 for rows > 0 Set r2 = r.Offset(1, 0).Resize(r.Rows.Count - 1).SpecialCells(xlCellTypeVisible) 'find the filtered rows r2.copy wsSummary.Range("A" & Rows.Count).End(xlUp).Offset(1) 'copy the filtered rows End If Next wsSummary.Range("A1:E1").Value = Worksheets(2).Range("A1:E1").Value 'copy headers into summary End Sub
if you need further help, please attached a sample workbook. Or go to the hire help section.
Hi Paul - does this work?Code
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) If ActiveCell.Column = 1 Then 'David McRitchie, 2007-09-07 insrtrow.htm on double-click '-- will copy more often than Extend Formulas and Format (tools option) Cancel = True Target.EntireRow.Copy Cells(Target.Row + 1, 1).EntireRow.Insert Cells(Target.Row + 1, 1).EntireRow.Select ActiveSheet.Paste Application.CutCopyMode = False On Error Resume Next '-- customize range for what cells constants can be removed -- Intersect(Selection, Range("E:IV")).SpecialCells(xlConstants).ClearContents Cells(Target.Row, 5).resize(2).Value = 1 On Error GoTo 0 Else End If End Sub
Just one extra line towards the end of the macro.
Hi Lisa -welcome to the forum - if you attach your code in a workbook and remove any confidential data then maybe we can help you a little more.
Subscript out of range could be that you are referring to an incorrect worksheet name e.g. Worksheets("Shhet1") would cause a subscript out of range, or if you are referring to an array, you may accidentally refer to an array element that doesnt exist. say there are 100 elements in the array and you referred to array(101), then this would also cause a subscript out of range.
Also updated thread title
Hi JL2509, I would be interested in seeing what you came up with for a solution. Please find attached one approach from me. Array Formula:
=IFERROR(INDEX($C$3:$C$15,LARGE((($F$3:$F$15="Contract Owner")+($F$3:$F$15="Main Contractor"))*($G$3:$G$15="Active")*ROW($F$3:$F$15)-2,ROW(1:1))),"")
Thanks Pike - that works... its a better option than my multiple if statements, and complicated IIF effort.
To restate the problem - if any of the ranges in a union is nothing then the resulting union is also nothing. So for example.
Union ("A1", "E10") results in a range("A1","10")
Union ("A1", "E10","G20") results in a range("A1","10","G20")
Union ("A1", nothing ,"G20") results in a range = nothing (as opposed to a range with "A1" and "G20").
So in my case, I had to test the ranges before "unioninising" them
its a bit of a limitation on Union that I wasnt aware of... and it kinda sucks if you are doing a union with many ranges.
You should use the "Databodyrange" method for the listobject to work with the data in the table. Databodyrange will always point to your data excluding your headers. When you combine this with specialcells(xlcelltypevisible) you will see how many cells are hidden or not.
You can also set a range to those visible cells and then set their value to whatever you want... for example:Code
Option Explicit Public Sub test() Dim lo As ListObject Dim r As Range Set lo = ActiveSheet.ListObjects(1) lo.Range.AutoFilter 6, "=" Debug.Print "There are " & lo.DataBodyRange.Rows.Count & " rows in the this listobject" Debug.Print "There are " & lo.DataBodyRange.Columns(6).SpecialCells(xlCellTypeVisible).Cells.Count & " visible rows being displayed" Set r = lo.DataBodyRange.Columns(6).SpecialCells(xlCellTypeVisible) 'set a range variable to the visible cells. r.Value = "This cell is empty" 'updates all the visible cells in the table with a value. End Sub
note - if there are NO blanks in the column 6, the above code will fail, so you should allow the error to occur with "On error resume next" and then trap the error with something like "if not r is nothing then...."
I had a problem today where I needed to indentify missing formulas from a column of data. Lets assume the data is in A1:A10.
I thought it was a simple problem using specialcells method to identify constants (i.e. not a formula) and also blanks. This was fine, but I realised quickly that UNION will fail if any of the ranges were "nothing" i.e. the range was missing either a constant or a blank. So below are the three options. The last two worked, but arent ideal.Code
Option Explicit Public Sub test() Dim r1 As Range Dim r2 As Range Dim r3 As Range Dim r4 As Range On Error Resume Next Set r1 = Range("$A1:A10") Set r2 = r1.SpecialCells(xlCellTypeConstants) Set r3 = r1.SpecialCells(xlCellTypeBlanks) 'create range for both blank cells and constants Set r4 = Union(r2, r3) 'results in r4 = nothing if either r2 or r3 is nothing, Debug.Print r4.Address 'this works but it is FUGLY If r2 Is Nothing Then If r3 Is Nothing Then Set r4 = Nothing Else Set r4 = r3 End If Else If r3 Is Nothing Then Set r4 = r2 Else Set r4 = Union(r2, r3) End If End If Debug.Print r4.Address 'This seems to work... but hard to maintain. Set r4 = IIf(r2 Is Nothing, IIf(r3 Is Nothing, Nothing, r3), IIf(r3 Is Nothing, r4, Union(r3, r4))) Debug.Print r4.Address End Sub
Are there any other simpler suggestions (without loops anyway) to find missing formulas from a column of data.
if you have a pbix I will try and take a look too on the PBI desktop
rajakoli636 - Banned. Completely unacceptable response. KJ has responded 5 times to this thread to give you code and free advice on HIS own time. Learn a little gratitude and decorum. Have a nice day.
So far as I understand the recordset.find method can only take one criteria parameter so I think you are snookered there, but why dont you change SQL statement to include the search criteria... e.g. Select jmapartID, omlPartID from x where jmaPartID = c.value and omlpartID = c.value
Put that SQL in the For each loop
and just rsOra.recordcount on the result.
That could be nonsense of course as I'm after two glasses of wine and my SQL and DAO are super rusty.
Let me know if this works for you:
Dim dblAnswer As Double
Dim rng As Range
Dim rTemp As Range
Application.ScreenUpdating = False
On Error Resume Next
Set rng = Worksheets("Page1_1").UsedRange.Columns("I").SpecialCells(xlCellTypeConstants, xlNumbers)
If Not rng Is Nothing Then
dblAnswer = CDbl(InputBox("Enter Multiplier for Column I", "Multiplier", 1))
If dblAnswer <> 0 Then
Set rTemp = Worksheets("Page1_1").UsedRange.SpecialCells(xlLastCell).Offset(1, 1)
rTemp = dblAnswer
rng.PasteSpecial xlPasteValues, xlPasteSpecialOperationMultiply
rTemp = ""
Application.CutCopyMode = False
MsgBox "No numbers cells found in Column I"
On Error GoTo 0
Application.ScreenUpdating = True
I'll look at this now for you JL
Got it... slight amendment for me:
Dim oServ As Object
Dim cProc As Variant
Dim oProc As Object
Set oServ = GetObject("winmgmts:")
Set cProc = oServ.ExecQuery("Select * from Win32_Process")
For Each oProc In cProc
ActiveSheet.Range("A" & Rows.Count).End(xlUp).Offset(1) = oProc.Name
Hi Aju - I thought GCExcel was working on this project as per post number 2 above?