• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Quick Edit Question: How to modify this code after splitting the original column

T

thereseexceljakubiak

New Member
Hi! So this code below, works awesomely- thanks to Excel Ninja! - but I now i have modified the data table so all the columns are screwed up!


BEFORE:

ALL IN COLUMN B:


Date

Item1

Item2

Item3

NextDate

Item1

Item2

Item3


Goal was to find a specific Date, then find a specific Item under that date and insert a row with User Input going to the cell in column B. The cell in Column C just copied down the formula from above.


NOW:


COL B

has formula that needs to be copied down


COL C -

Date

Same Date above

Same Date above

Same Date above

Same Date above

NextDate

Same Date above

Same Date above

Same Date above

Same Date above


Col E:

Item1

Item2

Item3

Item4

Item1

Item2

Item3

Item4

Item1

Item2

Item3

Item4


Goal is to find a specific Date (in col C) AND specific Item (in col E), then insert a NEW ROW with User Input going to the cell (in column E). The cell in Column B just copies down the formula from above. The cell in Column C should just equal the date above.


Here is the ORIGINAL MACRO:

[pre]
Code: 
Sub AddAItem()

Dim strReply As String
Dim lReply As Long
Dim LastRow As Long
Dim StartCell As Range
Dim vFound As Range
Dim newTerm As String

MsgBox ("This macro will add a New Item to the Item column B.  It will find a row with your exact item and insert a row beneath ALL instances.  Once the macro executes, an Undo will not work. To CANCEL, please press CANCEL on the next screen.")

With ActiveSheet
LastRow = Cells(Rows.Count, "B").End(xlUp).Row
End With

'Prompt user for what day/value to look for to start at
Set StartCell = Range("B:B").Find(InputBox("What Date would you like the New Rows to Start From? E.g., 10/1/2012"))

'Adjust start cell to be something in col B
If StartCell Is Nothing Then
Set StartCell = Range("B6")
Else
Set StartCell = StartCell.Offset(0, 1)
End If

'Break this out to separate line, check for null
strReply = InputBox("Please Enter the Item to Search For. The New Item will be inserted after this row:")
If strReply = vbNullString Then
lReply = MsgBox("An executed macro cannot be Undone. Do you wish to cancel?", vbYesNo)
If lReply = vbYes Then Exit Sub
End If

Set vFound = Range(StartCell, Cells(LastRow, "B")).Find(What:=strReply, _
After:=StartCell, LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)

newTerm = InputBox("Please Enter New Item to add:")

If Not vFound Is Nothing Then
Application.ScreenUpdating = False
vStart = vFound.Address
Do
Rows(vFound.Row + 1).Insert (xlShiftDown)
Cells(vFound.Row + 1, "B").Value = newTerm
Cells(vFound.Row + 1, "C").FormulaR1C1 = "=sum(RC4:RC40)"
Set vFound = Cells.FindNext(vFound)
Loop Until vFound.Address = vStart
Application.ScreenUpdating = True
Else
MsgBox ("Not Found")
End If

End Sub
[/pre]
 
Hello again!

Did some major rewriting, but I think this is what you described.

[pre]
Code: 
Sub AddAItem()

Dim StartCell As Range
Dim newRow As Long
Dim newTerm As String
Dim searchDate As Date
Dim searchValue As String
Dim firstAddress As String
Dim itemCount As Long

MsgBox ("This macro will add a New Item to the Item column B. " & vbCr & _
"It will find a row with your exact item and insert a row beneath ALL instances. " & vbCr & _
"Once the macro executes, an Undo will not work. To CANCEL, please press CANCEL on the next screen.")

'Prompt user for what day/value to look for to start at
On Error Resume Next
searchDate = InputBox("What date are you looking for?", "Date", Date)
searchValue = InputBox("What item are you looking for?", "Item:")
On Error GoTo 0

If searchDate = 0 Or searchValue = "" Then Exit Sub

Set StartCell = Range("C:C").Find(searchDate, Range("C1"))

'Adjust start cell to be something in col C
If StartCell Is Nothing Then
MsgBox "Date not found!"
Exit Sub
End If

firstAddress = StartCell.Address

'Prompt user for
newTerm = InputBox("Please Enter New Item to add:", "New Item")

'=====================
'BEGIN CHANGING SHEET
Application.ScreenUpdating = False
itemCount = 0
Do
'Loop dates until col E is specified item
Do Until StartCell.Offset(0, 2).Value = searchValue
Set StartCell = Range("C:C").FindNext(StartCell)
If StartCell.Address = firstAddress Then
'Looped through everything, but no match found
GoTo EscapeHatch
End If
Loop

'Item found!
itemCount = itemCount + 1
StartCell.Offset(1, 0).EntireRow.Insert xlDown
newRow = StartCell.Row + 1

'Input our new values
Cells(newRow, "B").Formula = Cells(newRow - 1, "B").Formula
Cells(newRow, "C").Value = Cells(newRow - 1, "C").Value
Cells(newRow, "E").Value = newTerm

'go to next cell
Set StartCell = Range("C:C").FindNext(StartCell)
Loop Until StartCell.Address = firstAddress
'ALL DONE
'==============

EscapeHatch:
If itemCount = 0 Then
MsgBox "Item was not found with that date. No changes made."
Else
MsgBox "Task complete. Records added: " & itemCount
End If
Application.ScreenUpdating = True

End Sub
[/pre]
 
Hi, thereseexceljakubiak!

May I suggest you to change your nick name? It's too long and it overlaps the comment area making it unreadable.

Regards!

PS: Maybe I posted this in an older topic, I apologize:

http://chandoo.org/forums/topic/need-to-create-a-macro-to-find-a-txt-and-insert-and-prompt-user-for-text#post-50560
 
Thank you, Luke M...AGAIN!.. You are awesome!


The new macro works great but how do i modify it so that it keeps adding the new Item? I executed the code, it found the Start Date, added the NewItem (but only once) it didnt continue to add for all dates forward.
 
Perhaps I misunderstoon original post. Macro currently finds all instances where DATE and ITEM match, as specified here

Goal is to find a specific Date (in col C) AND specific Item (in col E),
Click to expand...
Hence the reason for the Loops. Actually, I could have rewritten with only 1 loop...I think I was in a rush. Written better:`

[pre]
Code: 
'=====================
'BEGIN CHANGING SHEET
Application.ScreenUpdating = False
itemCount = 0
Do
If StartCell.Offset(0, 2).Value = searchValue Then
'Item found!
itemCount = itemCount + 1
StartCell.Offset(1, 0).EntireRow.Insert xlDown
newRow = StartCell.Row + 1

'Input our new values
Cells(newRow, "B").Formula = Cells(newRow - 1, "B").Formula
Cells(newRow, "C").Value = Cells(newRow - 1, "C").Value
Cells(newRow, "E").Value = newTerm
End If
'go to next cell
Set StartCell = Range("C:C").FindNext(StartCell)
Loop Until StartCell.Address = firstAddress
'ALL DONE
'==============
[/pre]
 
Hi luke! I really feel bad bugging you.... but you are so very helpful! Your original code was not rushed, it worked perfectly. I think I did not explain it properly, I am sorry.


yes, the goal is to (1st step) find the Start Date AND Specific Item THEN Insert New Item. This is to find the starting point for the New Item.


But then the loop would continue to find all other instances of Specific Item(2nd step), where the repeated Specific Item is and Insert New Item ( regardless of Date - after initial Start Date)


Thank you for your time, Luke!
 
I think I got it now.

[pre]
Code: 
Sub AddAItem()

Dim StartCell As Range
Dim newRow As Long
Dim newTerm As String
Dim searchDate As Date
Dim searchValue As String
Dim firstAddress As String
Dim itemCount As Long

MsgBox ("This macro will add a New Item to the Item column E. " & vbCr & _
"It will find a row with your exact item and insert a row beneath ALL instances. " & vbCr & _
"Once the macro executes, an Undo will not work. To CANCEL, please press CANCEL on the next screen.")

'Prompt user for what day/value to look for to start at
On Error Resume Next
searchDate = InputBox("What date are you looking for?", "Date", Date)
searchValue = InputBox("What item are you looking for?", "Item:")
On Error GoTo 0

If searchDate = 0 Or searchValue = "" Then Exit Sub

Set StartCell = Range("C:C").Find(searchDate, Range("C1"))

'Adjust start cell to be something in col C
If StartCell Is Nothing Then
MsgBox "Date not found!"
Exit Sub
End If

firstAddress = StartCell.Address

'Prompt user for
newTerm = InputBox("Please Enter New Item to add:", "New Item")

'=====================
'BEGIN CHANGING SHEET
Application.ScreenUpdating = False
itemCount = 0
Do
If StartCell.Offset(0, 2).Value = searchValue Then
'Item found!
itemCount = itemCount + 1
StartCell.Offset(1, 0).EntireRow.Insert xlDown
newRow = StartCell.Row + 1

'Input our new values
Cells(newRow, "B").Formula = Cells(newRow - 1, "B").Formula
Cells(newRow, "C").Value = Cells(newRow - 1, "C").Value
Cells(newRow, "E").Value = newTerm

'Begin finding all other instances of this item
Dim StartingRow As Long
Set StartCell = StartCell.Offset(0, 2)
StartingRow = StartCell.Row

Set StartCell = StartCell.EntireColumn.Find(searchValue, StartCell)
Do Until StartCell.Row <= StartingRow
'Item found!
itemCount = itemCount + 1
StartCell.Offset(1, 0).EntireRow.Insert xlDown
newRow = StartCell.Row + 1

'Input our new values
Cells(newRow, "B").Formula = Cells(newRow - 1, "B").Formula
Cells(newRow, "C").Value = Cells(newRow - 1, "C").Value
Cells(newRow, "E").Value = newTerm

Set StartCell = StartCell.EntireColumn.FindNext(StartCell)
Loop
GoTo EscapeHatch
End If
'go to next cell w/ matching date
Set StartCell = Range("C:C").FindNext(StartCell)
Loop Until StartCell.Address = firstAddress
'ALL DONE
'==============

EscapeHatch:
If itemCount = 0 Then
MsgBox "Item was not found with that date. No changes made."
Else
MsgBox "Task complete. Records added: " & itemCount
End If
Application.ScreenUpdating = True

End Sub
[/pre]
 
Luke!... another question....


how can I edit this line:


Cells(newRow, "B").Formula = Cells(newRow - 1, "B").Formula


so that the "formula" gets copied down with the relative cell change. If the row 4, cell above is Sum(E4:AC4)... the new row's formula in B should be Sum(E5:AC5)...right now it copies Sum(E4:AC4) into row 5.
 
Hi Therese ,


Try this :


Cells(newRow, "B").NumberFormat = Cells(newRow - 1, "B").NumberFormat


Repeat the above statement , with appropriate changes , for the other columns.


Narayan
 
Hello! Can someone please help me with one slight modification?


So the wonderful code, that Luke created above, finds a specific text and inserts a new row underneath with the User Prompted data.


Issue comes up when there are multiple fields (to search for) that have the first few characters the same.


Ex: If I want to find (and insert after) Item2, it inserts after Item2 & Item23 & Item24... I just want it to find (and insert after) "Item2"


BEFORE:

Date

Item1

Item2

Item232

Item233

Item24

NextDate

Item1

Item2

Item232

Item233

Item24


How can I solve for this?
 
Hi, therese!


The issue is that the Find method works exactly as the Find feature from within a worksheet, it searches into cells but considering partial content, so try changing the code as follows.


From:

Set StartCell = Range("C:C").Find(searchDate, Range("C1"))

to:

Set StartCell = Range("C:C").Find(searchDate, Range("C1"), ,xlWhole)


The 4th parameter is LookAt, which by default assumes xlPart.


Just advise if any issue.


Regards!


PS: take care that this method overrides the default or last used value for manual finding operations within worksheets, so next time set it properly by clicking on the "Options" button of the search dialog.
 
Hi SirJB7!...thank you! I thought I would have to add the XLWhole but I couldnt figure out where to add it!


but if I modify the "rangeC:C" line, would that solve for the "Item"s that is searching for below the Date? the DAte search has been working great, the issue is when i search for the "item" beneath the Date.


I was thinking i would have to modify the line for: "SearchValue"


StartCell.Offset(0, 2).Value = searchValue ?


EDIT:

...oohh...wait, i think i see what you added...let me try that. thanks!
 
Hi, therese!


I apologize for having fully read the code, the proper change should be as,

from:

Set StartCell = StartCell.EntireColumn.Find(searchValue, StartCell)

to:

Set StartCell = StartCell.EntireColumn.Find(searchValue, StartCell, ,xlWhole)


And restore the original Find for searchDate, even it doesn't do any harm.


Regards!
 
You must log in or register to reply here.
Back
Top