Avatar of Andreas Hermle
Andreas Hermle
Flag for Germany asked on

Aggregate several small Actions (Searching, Summing etc.) into a VBA Code

Dear Experts:

I wonder whether some expert could help me write this VBA code.

If F8 of the 'TecData' worksheet of the currently open workbook = "" Then exit sub

If F8 of the 'TecData' worksheet <> "", Then  grab the contents of F29 of the'TechData' worksheet and search that cell contents in Row 5 of the Worksheet 'Workshop'.

If that Search Term is not found in Row 5 of the worksheet 'Workshop', a MsgBox 'Date not found' is to pop up and the macro is to exit

If the Search Term is found in Row 5 of the worksheet 'Workshop', select that cell and perform the following intersection action …
=OFFSET($A$1,ROW(A24)-1,COLUMN('Cell Reference of the previously Selected Cell')-1)

The cell of that intersection action is to be selected (Lets call this cell 'Intersection Cell')

Grab the cell contents of F8 of the 'TecData' worksheet and add (summing up)  that figure to the cell contents of  the Intersection Cell (Worksheet 'Workshop')

Help is much appreciated. Thank you very much in advance.

Regards, Andreas
Microsoft ExcelVisual Basic Classic

Avatar of undefined
Last Comment
Andreas Hermle

8/22/2022 - Mon
Rgonzo1971

Hi,

pls try
Sub gg()
Dim varValue
Dim IntersectCell
If Sheets("TechData").Range("F8").Value = "" Then Exit Sub
varValue = Sheets("TechData").Range("F29").Value
Set Rng = Nothing
On Error Resume Next
Set Rng = Sheets("Workshop").Range("5:5").Find(varValue)
On Error GoTo 0
If Rng Is Nothing Then
    MsgBox "Date not found"
    Exit Sub
End If
Set IntersectCell = Evaluate("=OFFSET($A$1,ROW(A24)-1,COLUMN(" & Rng.Address & ")-1)")
Sheets("TechData").Range("F8").Value = Sheets("TechData").Range("F8").Value + IntersectCell.Value
End Sub

Open in new window

Regards
Andreas Hermle

ASKER
Hi Rgonzo,
thank you very much for your swift response. The 'find-action' does not work somehow, I will do some more testing and then get back with a feedback.

Best Regards, Andreas
Rgonzo1971

Could you send a dummy?

or try

Sub gg()
Dim varValue
Dim IntersectCell
If Sheets("TechData").Range("F8").Value = "" Then Exit Sub
varValue = Sheets("TechData").Range("F29").Value
Set Rng = Nothing
On Error Resume Next
Set Rng = Sheets("Workshop").Range("5:5").Find(varValue)
On Error GoTo 0
If Rng Is Nothing Then
    MsgBox "Date not found"
    Exit Sub
End If
Set IntersectCell = Evaluate("=OFFSET('Workshop'!$A$1,ROW('Workshop'!A24)-1,COLUMN('Workshop'!" & Rng.Address & ")-1)")
Sheets("TechData").Range("F8").Value = Sheets("TechData").Range("F8").Value + IntersectCell.Value
End Sub

Open in new window

I started with Experts Exchange in 2004 and it's been a mainstay of my professional computing life since. It helped me launch a career as a programmer / Oracle data analyst
William Peck
Andreas Hermle

ASKER
Hi Rgonzo,

thank you very much for your great help. I tweaked your last code a little bit and my requirements are now getting closed to be met.

Line 15 of your last code was changed to ...
IntersectCell.Value = Sheets("TechData").Range("F8").Value + IntersectCell.Value
... to suit my needs.

I now know why the find action does not work. I should have told you that I am searching for a date value. I did not know that finding actions must be coded differently with date values. I have converted the date values into serial numbers and then your find action works well.

Thats what I found on the internet concerning 'Dates in the Find Method'. I am sure that you know all this but I was regrettably not able to change my code accordingly.
________________________________________
'Dates In The Find Method
'
'Using the .Find  method to search for dates can be a bit tricky.  Regardless of how the date is formatted to display (as long as it is a date format of some sort), you must search for it in its "standard" format, e.g., "7/18/1998" rather than "7/18/98" or "July 18, 1998".   For example,
'
'Set FoundCell = Range("A1:A100").Find(what:="7/18/1998")
'
'Alternatively, you can use the DateValue function to convert any date format into an Excel serial date, and search the formulas of the range (even though they are not formulas in the conventional sense) to find your date.
'
'Set FoundCell = Range("A1:A100").Find _
'   (what:=DateValue("July 18, 1998"), LookIn:=xlFormulas)
__________________________________________________________________________________________________

So Rgonzo would you be so kind as to change the 'Find Action' in your last code based on the fact that I am using dates. The dates have German Format: Dates have been entered in this format: DD.MM.YYYY (formatted user defined just as 'DD')

Help is much appreciated. Thank you very much in advance.

Regards, Andreas
Andreas Hermle

ASKER
Hi Rgonzo,

further to the fact that a date value has to be found (line 8 of your code) there is another requirement:

As I said in my previous post. I changed line 15 of your last code to ...
IntersectCell.Value = Sheets("TechData").Range("F8").Value + IntersectCell.Value

Open in new window

... to suit my needs.

The intersectCell.Value that is entered with the last macro action is to be copied several times to the right of the value. The number of the copy actions is based on cell value F33 of the 'TechData' Worksheet.

Let's assume the intersect cell reference is 'CL24'. The IntersectCell.Value is 7.
The F33 cell value of the 'TechData' worksheet is 5. Now the IntersectCell.Value of 7 is to be copied to CM24, CN24, CO24, CP24 and CQ24 (5 times)

Help is much appreciated. Thank you very much in advance.

Regards, Andreas
ASKER CERTIFIED SOLUTION
Rgonzo1971

THIS SOLUTION ONLY AVAILABLE TO MEMBERS.
View this solution by signing up for a free trial.
Members can start a 7-Day free trial and enjoy unlimited access to the platform.
See Pricing Options
Start Free Trial
GET A PERSONALIZED SOLUTION
Ask your own question & get feedback from real experts
Find out why thousands trust the EE community with their toughest problems.
Andreas Hermle

ASKER
Hi Rgonzo,

oh, great this did the trick. Thank you very much for it. I will do some more testing and then let you know.

Regards, Andreas
⚡ FREE TRIAL OFFER
Try out a week of full access for free.
Find out why thousands trust the EE community with their toughest problems.
Andreas Hermle

ASKER
Great job as always i really appreciate it.