I have this snippet of code that I've borrowed from other post and edited(or at least tried) that I'm trying to use to subtotal some dynamic ranges. I use a key column with 0's, 1's, and 2's. I want the code to add all the coorosponding columns across from each 1 until it hits a 2 and then put the subtotal in the column with the 2. Currently, my code keeps running backwards so it is putting the wrong subtotals in. Below is a snippet of my code.
'count all 1's in each section till next 2 for subtotaling each section
With Range("P13:P" & lRow1)
Set rFind = .Find(What:=2, LookIn:=xlFormulas, SearchOrder:=xlByRows, _
Lookat:=xlWhole, SearchDirection:=xlNext, searchFormat:=False)
If Not rFind Is Nothing Then
s = rFind.Address
Do
Set r1 = rFind
Set rFind = .FindNext(rFind)
If rFind.Address = s Then
Set rFind = .Cells(.Cells.Count)
r1.Offset(, -5).Value = Application.Sum(Range(r1.Offset(-1, -5), r1.Offset(, -5)))
Exit Sub
End If
r1.Offset(, -5).Value = Application.Sum(Range(r1.Offset(-1, -5), rFind.Offset(, -5)))
Loop While rFind.Address <> s
End If
End With
Even now that I type this question out I'm thinking I should take a different approach. My code places a 0 at each blank line and I currently have it set to place a 0 on the line above the 1st 1. With that, I could maybe find the 1st 0 then add all the 1's till i reach a 2 then find the next 0 and so forth. Does that make sense?
Below is a picture of what the macro is currently producing.
You can actually do this with a formula
=IF(P3=2,SUMIF($P$1:P2,1,$K$1:K2)-SUMIF($P$1:P2,2,$K$1:K2),"")
in each cell in K where there is a 2 in column P. Could use VBA to insert this.
Here's a straight VBA solution:
Sub x()
Dim r As Range
For Each r In Range("K:K").SpecialCells(xlCellTypeConstants).Areas
r(r.Count + 1).Value = Application.Sum(r)
Next r
End Sub
Related
I am working on a macro to go through stock data. When no data is available on a given date, the data shows "-" in those rows. I need to delete those rows.
I have come up with a macro that deletes the first row found. I need to keep it going until all rows with "-" are deleted.
How can I do this with a Do Until loop?
Sub removejank()
'
' removejank Macro
Cells.Find(What:="-", After:=ActiveCell, LookIn:=xlFormulas2, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False).Activate
If ActiveCell.Value = "-" Then
Rows(ActiveCell.Row).Delete
End If
End Sub
There are many possible ways to loop through and delete rows.
In your example, using Activate significantly slows down runtime when you are looping data. .Activate is almost completely avoidable in just about every circumstance. Obviously, I see that what you've done was with the macro recorder, so it's understandable that it's there.
Anyway, try the following code. This only looks in column A. If you need to look in a different column, then change the "1" in this line:
If .Cells(r, 1).Value = "-" Then
To the column # you want to look in. Also, you will likely need to change the sheet name in this line:
With ThisWorkbook.Worksheets("Sheet3")
to match the sheet name you are wanting the code to run in.
So the way this method of the many methods out there works is that you will loop through every line in column A with For r = 1 .... Each loop iteration you are looking in the cell's value. If it equals -, then the If statement is true and proceeds to add the cell to our special range that we named delRng. You are not actually deleting the row just yet, only tracking them in this range.
Once finished, you will take all the single cells in the delRng, and using the .EntireRow property, delete them all at once. This is generally faster than deleting rows one at a time.
Public Sub RemoveJunk()
Dim delRng As Range, r As Long
With ThisWorkbook.Worksheets("Sheet3")
For r = 1 To .Cells(.Rows.Count, 1).End(xlUp).Row
If .Cells(r, 1).Value = "-" Then
If delRng Is Nothing Then
Set delRng = .Cells(r, 1)
Else
Set delRng = Union(delRng, .Cells(r, 1))
End If
End If
Next r
End With
If Not delRng Is Nothing Then delRng.EntireRow.Delete
End Sub
I need to find the value "5005" (only this value) in column J:J, insert a new row below it, and then fill the row with values in columns A-U.
I am new to VBA and I am unable to do this without making a mess of code.
The draft would look something like this
Find all cells with value 5005 in column J:J,
Insert Row below,
Put value1 in A,
Put Value2 in B,
etc.... until column U,
Repeat on the next cell that has "5005" in it until there are no more
I am unsure what code would work best at this point and I think seeing this written out by a pro would help significantly.
In the messy code I've provided below I was able to search for the value "5005" and insert a line below it, but whatever cell I have selected in excel will be filled with the value "TRUE" and the code is quite messy. Not sure If I was going the right direction with it.
Sub AAAAAAAtest()
Dim find5005 As Range
'Have excel search 1 column instead of all cell
Set find5005 = Cells.Find(What:="5005", LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByColumns, _
SearchDirection:=xlNext, MatchCase:=True, SearchFormat:=False)
If find5005 Then ActiveCell.Value = find5005.Offset(1).EntireRow.Insert
End Sub
Narrative is in the code comments
Option Explicit
Sub insert5005()
Dim rng As Range, urng As Range, faddr As String
Dim vals As Variant
'get some dummy values quickly
vals = buildAU()
With Worksheets("sheet5")
'find first 5005
Set rng = .Range("J:J").Find(What:="5005", after:=.Cells(.Rows.Count, "J"), _
LookIn:=xlFormulas, LookAt:=xlPart, _
SearchOrder:=xlByRows, SearchDirection:=xlNext)
'continue if found
If Not rng Is Nothing Then
'record first found cell
faddr = rng.Address
'start loop for insert, populate and additional cells
Do
'insert new row
rng.Offset(1, 0).EntireRow.Insert
'populate row
.Cells(rng.Offset(1, 0).Row, "A").Resize(1, UBound(vals) + 1) = vals
'look for another
Set rng = .Range("J:J").FindNext(after:=rng)
'keep going until first address is reached a second time
Loop Until rng.Address = faddr
End If
End With
End Sub
Function buildAU()
'construct some dummy values
Dim i As Long, tmp As String
For i = 65 To 85
tmp = tmp & Format(i, "|v\alu\e00")
Next i
buildAU = Split(Mid(tmp, 2), Chr(124))
End Function
I know this is a simple fix, but all my searching has not uncovered the answer. I need to create a dynamic hyperlink.
Sheet 1
Column A1 = 3/0/1
Column A2 = 3/0/2
Sheet 2
Column C3 = 3/0/1
Column D3 = 3/0/2
Now, creating a link on Sheet 2 to the appropriate cell in Sheet 1 is easy. Think is, Sheet 1 has the potential to be sorted in a variety of ways. So I need the link dynamic. I need it to find "3/0/1" whether it's in column A1 or A77, or whatever.
I've seen examples using the ADDRESS function within the HYPERLINK function, but can't get it to work. Any ideas?
This might actually be one of those time when you want to use .Selection to govern which cells the macro is enacted upon.
Sub hlink_Sel()
Dim fnd As Range, sel As Range
On Error Resume Next
With Sheets("Sheet1")
For Each sel In Selection
Set fnd = .Columns("A:A").Find(What:=sel.Text, After:=.Cells(1, 1), LookIn:=xlFormulas, _
LookAt:=xlWhole, SearchDirection:=xlNext, MatchCase:=False)
If Not fnd Is Nothing Then
Debug.Print fnd.Address(0, 0, xlA1, external:=True)
.Hyperlinks.Add Anchor:=sel, Address:="", _
SubAddress:=fnd.Address(0, 0, xlA1, external:=True), TextToDisplay:=sel.Text
End If
Next sel
End With
Set fnd = Nothing
End Sub
Just select some cells that are supposed to have their values duplicated in Sheet1's column A and run the macro. Given the odd nature of your sample data, I've used .Text as the search term in the find operation. Note that the .Address function has the external parameter set to true in order that the worksheet name is included.
Currently I have macro that looks in another document and copies an offset cell if a value is present. I already have the code below (only the part that selects/copies the offset cell), but it only will copy one row. This is fine for most of the items I am searching for. Does anyone know how to modify the code below to copy all cells that contain my searched value?
For I = LBound(MyArr) To UBound(MyArr)
Set Rng = .Find(What:=MyArr(I), _
After:=.Cells(.Cells.Count), _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not Rng Is Nothing Then
FirstAddress = Rng.Address
Do
'mark the cell in the column to the right if "Ron" is found
Rng.Offset(0, 4).Select
'Rng.Copy "A" & Rcount
Set Rng = .FindNext(Rng)
Loop While Not Rng Is Nothing And Rng.Address <> FirstAddress
Selection.Copy (Rng)
End If
Next I
End With
What I would suggest is a loop for the .Find method.
So you have a range of data namely MyArr imagine its 50 items long. You want to look from 0 to 50 until you find your item.
Lets say you find it in positon 8. Now you do another search but this time from items 9 to 50 and see if you find a match. If you dont you know there are no more. If you do you repeat the above until you run out of elements in the array(range) or you have no more matches. Does that make sense?
I have a number of sheets in one excel ..
What I am going to do is consolidate as per the column title into master sheet.
If the column not present in any of the sheets means , filled as “Not available “ in master sheet for those data’s
Below code written by me.. as per my understanding …the code which I pasted here is correct .. but there was a prob in loop .. I don’t where it is ..
Can anyone help me out from this prob …
Sub Sathish()
'Declaration
Dim ii
Dim j As Integer
Dim a As Integer
Dim i As Integer
Dim rrange As Range
Dim trange As Range
'Assigning
a = Worksheets.Count
ii = Array("saaa", "Description", "saaa", "Model", "sathish")
Dim aa As Integer
'Practical
'Call Create_new_sheet
For j = 1 To a
Sheets(j).Select
If Not ActiveSheet.Name = "Master" Then
For i = 1 To 3
Rows("1:1").Select
For Each trange In Selection
If trange.Value = ii(i) Then
Selection.Find(What:=ii(i), After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Activate
ActiveCell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Copy Destination:=Sheets("Master").Cells(6550, i).End(xlUp).Offset(1, 0)
Else
Sheets("Master").Cells(6550, i).End(xlUp).Offset(1, -1).Select
Selection.End(xlDown).Offset(0, 1).Select
ActiveCell.Value = "[not applicable]"
ActiveCell.Offset(-1, 0).Select
Range(ActiveCell, Selection.End(xlUp)).Offset(1, 0).Select
For Each rrange In Selection
rrange.Value = "[not applicable]"
Next rrange
End If
Next trange
Next i
End If
Next j
End Sub
I was planning to post this as a comment but since there is lot of text, it wouldn't allow me.
Sathish, your understanding of the above problem is almost correct but you missed on few parts.
If trange.Value = ii(i) Then This part will only check first three values of the array. If you notice your loop runs only 3 times (For i = 1 To 3)
Also that is not how .Find is used :) I would recommend going through this link and re-apply the logic.
TOPIC: .Find and .FindNext In Excel VBA (See Section 1)
LINK: http://siddharthrout.wordpress.com/2011/07/14/find-and-findnext-in-excel-vba/
When I write code, I write the logic down and then code accordingly. I would shamelessly recommend this link as well
TOPIC: To ‘Err’ is Human (See Section 1 for what I meant by above. See other sections as well to improve your code)
LINK: http://siddharthrout.wordpress.com/2011/08/01/to-err-is-human/
Here is an example on how the logic would look like.
LOGIC
Loop Through All the worksheets
Check if the Sheet is not Master
Set the search range as 1st row
Use .Find to check if the values in the array is present in row 1. Use a separate loop here.
If found (then do this)
If not found (then do this)
If you are still stuck then post the code that you tried and we will take it from there.
HTH
Sid