Need Help with VBA Code

Megha1484 · Feb 15, 2019

Hi,
I have been struggling with this VBA code for quite some time now and would appreciate any help with it. I have attached a sample spreadsheet I am working with. First sheet shows the raw data that comes from the SharePoint and second sheet shows the report I am trying to build form the raw data. Goal is to search for each question (starts at col C) and look for any “No – Correction Needed” and “No – Correction Not Needed” words and display the corresponding “ID”, “Name”, “Notes” associated with the question and “correction made”. I don’t want any “yes” or NA in the report only “Nos*”.
I have filled question “TND” as an example. So, when I run the code it should go through the entire col look for Nos and fill out rest of fields that comes from raw data. Here is the code I am trying to work with.
There are couple of issues with it. First, every time I will run the code it will start from scratch instead of picking up the row where it left off last. This could be an issue overtime when data starts building up.
Second, I am going to have to write the same code 32 times one for each question, which is OK as long as I can make this code work.
Third, I think its not recognizing the new report location where I am trying to build the report.

Sorry, I could not find a way to attach to Excel workbook so copied the sheets at the bottom of the email. First table is Rawdata and second table is Report. Thanks in advance!

Sub Report ()
'builds the report line by line based on iterative check of criteria

'clear old report data
Sheets ("Report").Select
Range("3:3").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Delete Shift:=xlUp

'set up for report build
Range("Report[Question ID]").Select

'iteratively search for selected criteria for Q1

Dim Q1Column As Range
Dim q1answer As Range
Dim q1current As Range

Set Q1Column = Sheets("Rawdata").Range("Table_Rawdata[Memo]")
For Each q1answer In Q1Column.Cells
If q1answer.Value Like "No*" Then
Set q1current = Range(Cells(ActiveCell))
Range("Report[@[Question ID]]").Select
Set ActiveCell.Value = "Q.1"
ActiveCell.Offset(0, 1).Select
Set ActiveCell.Value = "TD"
ActiveCell.Offset(0, 1).Select
Set ActiveCell.Value = "Deatiled Question Description"
ActiveCell.Offset(0, 1).Select
Set ActiveCell.Value = "Memo"
ActiveCell.Offset(0, 1).Select
Set ActiveCell.Value = Cells(q1current.Row, Range("Table_Rawdata[@[Name]]").Column)
ActiveCell.Offset(0, 1).Select
Set ActiveCell.Value = q1answer.Value
ActiveCell.Offset(0, 1).Select
Set ActiveCell.Value = Cells(q1current.Row, Range("Table_Rawdata[@[CorrectionsMade]]").Column)
ActiveCell.Offset(0, 1).Select
Set ActiveCell.Value = Cells(q1current.Row, Range("Table_Rawdata[@[MemoNotes]]").Column)
ActiveCell.Offset(0, 1).Select
Set ActiveCell.Value = Cells(q1current.Row, Range("Table_Rawdata[@[ID]]").Column)

Else
End If
Next q1answer

'Next datum - copy code for the next question...
End Sub

RawData(Sheet1)

ID

Name

Memo

TND

STW

DecAcc

ConPro

CoD

BegDat

Duration

CP

Contribution

FIMF

MBP

Rpay

OffAcc

ReAcc

ReErr

Amt

ErrAmt

IC

Dmet

Status

ResAccute

Benaccu

PET

ComA

Au

Cplan

DMWU

SUIO

SalPre

Pdat

OUPY

Aman

ClInter

Wrkst

BupWkst

Lwaivers

Review

CC

Comp

TimExt

RDMD

Review Date

CorrectionsMade

MemoNOtes

TNDNotes

STWNotes

DecAccNotes

ConProNotes

CoDNotes

BegDatNotes

DurationNotes

CPNotes

ContributionNotes

FIMFNotes

MBPNotes

RpayNotes

OffAccNotes

ReAccNotes

ReErrNotes

AmtNotes

ErrAmtNotes

ICNotes

DmetNotes

StatusNotes

ResAccuteNotes

BenaccuNotes

PETNotes

ComANotes

AuNotes

CplanNotes

DMWUNotes

SUIONotes

SalPreNotes

PdatNotes

Item

4567678

MH

Yes

No - Correction Needed

N/A

No - Correction Needed

No - Correction Not Needed

Yes

N/A

Yes

N/A

No - Correction Needed

1000000

200000

Yes

No - Correction Needed

N/A

Yes

N/A

Yes

N/A

No - Correction Not Needed

Yes

N/A

No - Correction Needed

No - Correction Not Needed

1/30/2019

Yes

dgdd

Item

67890

SG

Yes

No - Correction Not Needed

Yes

No - Correction Not Needed

No - Correction Needed

N/A

Yes

N/A

No - Correction Needed

456667

500000

10000

Yes

N/A

Yes

N/A

Yes

No - Correction Needed

Yes

N/A

Yes

No - Correction Not Needed

Yes

N/A

No - Correction Not Needed

No - Correction Needed

No - Correction Not Needed

1/16/2019

No

fgfgdgdgd

bzdb

xb

fbxb

xb

eytsghsfth

fgfbxb

fbxbb

bbxb

xfbxb

fxgxfxh

fbxxfb

Item

45678

CL

Yes

No - Correction Needed

No - Correction Not Needed

N/A

No - Correction Needed

Yes

N/A

Yes

No - Correction Needed

1500000

200000

Yes

N/A

No - Correction Needed

No - Correction Not Needed

Yes

N/A

No - Correction Needed

Yes

No - Correction Needed

No - Correction Not Needed

2/13/2019

Yes

cvddfg

Item

45678

DG

Yes

No - Correction Not Needed

No - Correction Needed

N/A

Yes

N/A

Yes

700000

50000

Yes

No - Correction Not Needed

No - Correction Needed

Yes

No - Correction Not Needed

Yes

N/A

Yes

8/14/2019

No

cxvxcvxc

Item

45678

DL

Yes

No - Correction Not Needed

N/A

No - Correction Not Needed

No - Correction Needed

Yes

N/A

No - Correction Not Needed

750000

10000

N/A

Yes

No - Correction Needed

No - Correction Not Needed

Yes

No - Correction Needed

Yes

No - Correction Needed

Yes

4/16/2020

Yes

gdfhh

Item

45678

GS

Yes

No - Correction Needed

N/A

No - Correction Not Needed

No - Correction Needed

Yes

No - Correction Needed

300000

2000

N/A

Yes

No - Correction Not Needed

No - Correction Needed

Yes

N/A

Yes

N/A

Yes

No - Correction Needed

Yes

9/24/2020

No

gdfgg

Item

56789

MB

Yes

No - Correction Needed

N/A

No - Correction Not Needed

N/A

No - Correction Needed

Yes

N/A

Yes

No - Correction Needed

Yes

No - Correction Needed

Yes

600000

20000

No - Correction Not Needed

No - Correction Needed

Yes

No - Correction Needed

No - Correction Not Needed

Yes

No - Correction Not Needed

N/A

Yes

No - Correction Needed

No - Correction Not Needed

2/4/2021

No

sdgdsgsd

Item

234567

CL

Yes

No - Correction Not Needed

Yes

No - Correction Needed

N/A

No - Correction Needed

No - Correction Not Needed

Yes

No - Correction Needed

No - Correction Not Needed

Yes

1000000

50000

60000

Yes

No - Correction Not Needed

No - Correction Needed

Yes

N/A

Yes

No - Correction Needed

Yes

No - Correction Not Needed

N/A

Yes

No - Correction Not Needed

Yes

No - Correction Needed

No - Correction Not Needed

1/15/2019

No

sdgsdg

comments

Comment

Comments

comments

COmment

comments

Comments

Item

692877

NB

Yes

No - Correction Not Needed

No - Correction Needed

N/A

Yes

No - Correction Needed

Yes

N/A

Yes

N/A

957.19

N/A

Yes

N/A

Yes

N/A

1/21/2019

No

sdgsdgs

date corrected to reflect earlier onset

i:0#.w|sic\kspierin

ncm consult needed

Item

00325698

TG

1/15/2019

No

ertery

Item

693008

NB

N/A

Yes

N/A

No - Correction Needed

N/A

No - Correction Needed

N/A

1000

N/A

No - Correction Needed

N/A

Yes

N/A

No - Correction Needed

Yes

N/A

No - Correction Needed

N/A

No - Correction Not Needed

1/23/2019

No

eryery

disability date should be 10.1

Item

00323333

TG

1/8/2019

No

eryery

Item

Report (sheet#2)
PREFILLED FIELD	PREFILLED FIELD	PREFILLED FIELD	PREFILLED FIELD	Comes from Raw Data	Comes from Raw Data	Comes from Raw Data	Comes from Raw Data	Comes from Raw Data
Question ID	Category	QUESTIONS	list field	Name	Correctable/Not Correctable	ID	Notes	CorrectionMade
Q.2	TD	Detailed Question Description	TND	MH	No - Correction Needed	4567678	dgdd	Yes
Q.2	TD	Detailed Question Description	TND	SG	No - Correction Not Needed	67890	fgfgdgdgd	No
Q.2	TD	Detailed Question Description	TND	CL	No - Correction Needed	45678	cvddfg	Yes
Q.2	TD	Detailed Question Description	TND	DL	No - Correction Not Needed	45678	gdfhh	Yes
Q.2	TD	Detailed Question Description	TND	GS	No - Correction Needed	45678	gdfgg	No
Q.2	TD	Detailed Question Description	TND	MB	No - Correction Needed	56789	sdgdsgsd	No
Q.2	TD	Detailed Question Description	TND	NB	No - Correction Not Needed	692877	sdgsdgs	No
Q.3	TD	Detailed Question Description	STW
Q.3	TD	Detailed Question Description	STW
Q.3	TD	Detailed Question Description	STW
Q.3	TD	Detailed Question Description	STW
Q.3	TD	Detailed Question Description	STW
Q.3	TD	Detailed Question Description	STW
Q.3	TD	Detailed Question Description	STW
Q.3	TD	Detailed Question Description	STW
Q.5	DA	Detailed Question Description	DecAcc
	DA	Detailed Question Description	DecAcc
	DA	Detailed Question Description	DecAcc
Q.6	DA	Detailed Question Description	ConPro
Q.7	DA	Detailed Question Description	CoD
Q.8	PFA	Detailed Question Description	BegDat
Q.9	PFA	Detailed Question Description	Duration
	PFA	Detailed Question Description	Duration
Q.10	PFA	Detailed Question Description	CP
	PFA	Detailed Question Description	CP
Q.12	PFA	Detailed Question Description	FIMF
	PFA	Detailed Question Description	FIMF
Q.13	PFA	Detailed Question Description	MBP
	PFA	Detailed Question Description	Rpay
Q.14	PFA	Detailed Question Description	OffAcc
	PFA	Detailed Question Description	OffAcc
Q.15	PFA	Detailed Question Description	ReAcc

Megha1484 · Feb 19, 2019

It is working!!
Thanks a lot, Dante! I will make sure you get credit for this code.

DanteAmor · Feb 19, 2019

I'm glad to help you. Thanks for the feedback.

Megha1484 · Feb 21, 2019

Hi Dante,
sorry to bother you again. One small issue. The "Notes" column on Report sheet is returning only TND notes. I tried to change the range instead of referring to a "TNDNotes".column,
but it is not accepting it. Right now, the report gives me pretty much everything I want except for Notes column. I would like TNDNotes displayed next to TND list field, STW notes displayed next to
STW list field etc...
Thanks!!

DanteAmor · Feb 21, 2019

Change name TNDNotes by the new name, or put the number of column e.g.:

ws2.Cells(j, "H").Value = ws1.Cells(answer.Row, 8)

Code:

Sub Fill_Report()
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim answer As Range
    Dim q As Long, j As Long, initial As Long
    
    Application.ScreenUpdating = False
    
    Set ws1 = Sheets("Rawdata")
    Set ws2 = Sheets("Report")
    
    'clear old report data
    ws2.Rows("3:" & Rows.Count).ClearContents
    'ws2.ListObjects("Report").Resize Range("$A$2:$I$3")
    
    q = 1   'Initial question number
    j = 3   'Initial row target
    
    'Column C initial question To column AR end question
    initial = ws1.Range("Table1[#All]").Cells(1, 1).Row
    For i = Columns("C").Column To Columns("AR").Column
        For Each answer In ws1.Range("Table1[" & ws1.Cells(initial, i).Value & "]").Cells
            If answer.Value Like "No*" Then
                ws2.Cells(j, "A").Value = "Q." & q                                                      'question ID
                ws2.Cells(j, "B").Value = "Category"                                                    'category
                ws2.Cells(j, "C").Value = "Deatiled Question Description"                               'question
                ws2.Cells(j, "D").Value = ws1.Cells(1, i).Value                                         'list field
                ws2.Cells(j, "E").Value = ws1.Cells(answer.Row, Range("Table1[[Name]]").Column)  'name
                ws2.Cells(j, "F").Value = answer.Value                                                  'Correctable/Not Correctable
                ws2.Cells(j, "G").Value = ws1.Cells(answer.Row, 1)    'ID
                ws2.Cells(j, "H").Value = ws1.Cells(answer.Row, Range("Table1[[[COLOR=#ff0000]TNDNotes[/COLOR]]]").Column)  'Notes
                ws2.Cells(j, "I").Value = ws1.Cells(answer.Row, Range("Table1[[CorrectionsMade]]").Column)   'CorrectionMade
                j = j + 1
            End If
        Next
        q = q + 1
    Next
    
    Application.ScreenUpdating = True
    
    MsgBox "End"
End Sub[CODE]

[/CODE]

Megha1484 · Feb 22, 2019

Once again, thanks for the quick reply. I think my last message was little confusing. I did not provide a good explanation of what I was trying to accomplish.
Sorry about that.
So, the code that I had posted originally was meant to run 32 times for each question separately and the line below would have worked perfectly in that case because we knew what question we wanted to pull the information from. But thanks to your modified version I don't have to do that anymore. It saved me a lot of time and effort. Its now looking for wild card "no*" and fills out all the fields from Table1 and it is basically looking for all 32 questions at the same time rather than individually.

All the columns from "Question ID" till "ID" and "Corrections Made" is working perfectly on the Report, except for "Notes" column.
Other columns are easier because they are all fixed values but Notes column is not fixed. Here I would like to look the for the "No*" and fill out the corresponding NOTE in the notes column.

Issue is that "NO*" could appear in any question randomly, which impacts ONLY the "Notes" col in the Report. The code below will pull only notes from TND but if for some reason
the first "No*" appears in some other question then this line won't work. or replacing with a different name or number won't help because we don't know which notes to pull from.

ws2.Cells(j, "H").Value = ws1.Cells(answer.Row, Range("Table1[[TNDNotes]]").Column

so instead of pulling information from this specific column from Table1,it should be a range(only for "Notes"), I think.

For instance, if the first "No*" was found in "DecAcc" (Table1, row 2, Col F), then it would search for all NOTES from col AU to Col BY and pull "DecAccNotes"(Table1, row2, col AX), but if it was found in "ConPro" (Table1, row 3, col G) then
the it will do a search again and pull information from "ConProNotes" (table1, row3, col AY).

I apologize if this is confusing. Please let me know if this helps you understand the issue or if you need more clarification.

Thanks!
https://app.box.com/s/k331pem8w3jypbw3tux2xz65rty7zkwi

Megha1484 · Feb 22, 2019

Please discard the last post. I figured it out. The solution is a combination of what you had suggested earlier and changing the way row was displayed. Thanks!!

Modified code line - ws2.Cells(j, "H").Value = ws1.Cells(answer.Row, i + 7).Value

DanteAmor · Feb 22, 2019

Need Help with VBA Code

Megha1484

New Member

Megha1484

New Member

Excel Facts

DanteAmor

Well-known Member

Megha1484

New Member

DanteAmor

Well-known Member

Megha1484

New Member

Megha1484

New Member

DanteAmor

Well-known Member

Similar threads

Forum statistics

Share this page

Need Help with VBA Code

New Member

New Member

Excel Facts

Well-known Member

New Member

Well-known Member

New Member

New Member

Well-known Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock