简体   繁体   中英

Insert Row below if current Row is not blank in Excel with VBA

I currently have a Membership database whereby Applications/Payments are added per each member. I wish to be able to have one sheet with CURRENT Application/Payment sheet per member, and another for Archiving. Everything is ok, until it comes to adding a New Application/Payment where I require the now old Application/Payment details to be assigned to the Member in the Archive sheet.

I want the code to check if (1) Member Row in Archive is BLANK other than Col. "A", if so then (2) copy information here. (3) If NOT, Insert row directly below and copy information there.

I've managed to get (2) to work. I need help with (1) and (3) please.

'Records Sheet is Worksheet where Member Details are entered/edited
Sheets("Records").Select
Dim c As Range
Dim i As Integer
i = 1

'Looks in pre-populated Member ID Range in Archive Sheet
For Each c In Worksheets("Application Archives").Range("MemberID4")
'If a cell in Member ID Range = Member ID, Then Copy Date1 from Records Sheet to Archive Sheet, in same Row as Member ID
If c = Range("Member").Value Then
'Start using Applications Worksheet
Worksheets("Application Archives").Range("B5").Cells(i).Value = Range("App_Date").Value
Worksheets("Application Archives").Range("C5").Cells(i).Value = Range("Exp_Date").Value

End If
i = i + 1
Next c

UPDATE:

I have managed to solve my original issue posed above using the below code. Now however if there are 2 or more entries for a Member in the Archive Sheet, a Row is Inserted below EACH entry. I only want a maximum of one Row Inserted, preferably below the last entry.

If c = Range("Member").Value Then
'Start using Applications
    If IsEmpty(Worksheets("Application Archives").Range("B5").Cells(i).Value) = False Then
    Worksheets("Application Archives").Range("B5").Cells(i).Offset(1, 0).EntireRow.Insert
    Worksheets("Application Archives").Range("B5").Cells(i).Offset(1, -1).Value = Range("Member").Value
    Else

I can't get all this in a comment. This is along the lines of what I'd do.

'Records Sheet is Worksheet where Member Details are entered/edited
Sheets("Records").Select
Dim c As Range
Dim i As Integer
Dim bFound as Boolean 'Variable to detect whether you've found an entry or not
bFound=False 'Set to False for first iteration through loop
i = 1

'Looks in pre-populated Member ID Range in Archive Sheet
For Each c In Worksheets("Application Archives").Range("MemberID4")
Do While not bFound
'If a cell in Member ID Range = Member ID, Then Copy Date1 from Records Sheet to Archive Sheet, in same Row as Member ID
If c = Range("Member").Value Then
'Start using Applications

If IsEmpty(Worksheets("Application Archives").Range("B5").Cells(i).Value) = False Then
bFound=True ' Set value to True so that the loop exits
Worksheets("Application Archives").Range("B5").Cells(i).Offset(1, 0).EntireRow.Insert
Worksheets("Application Archives").Range("B5").Cells(i).Offset(1, -1).Value = Range("Member").Value

Else

End If
i = i + 1
Loop 
Next c

Now this will only insert one line, but it will do so on the first entry it finds. What I'd suggest is refactoring your For Each c in Worksheets to iterate backwards ie-bottom up, and also combine the bFound check into a single line. This should give you some ideas to work from though.

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM