Autofill and Reverse Autofill

[Anshu]

I have a sheet in which I want to autofill 3 cells by 3 different values based on a cell value from a range.
And also, in reverse, I want to autofill the single cell with the value, if I filled the 3 cells manually.

Please see the attachement Autofill.xlsx. I have explained everything there, in the attachment, in detail.


Thank you!!

[DocAElstein]

Hi
( Probably the word “Autofill” is not so good for this, since it is a bit miss leading: In Excel Auto Fill (https://support.microsoft.com/en-us/office/fill-data-automatically-in-worksheet-cells-74e31bdd-d993-45da-aa82-35a236c5b5db) has a specific meaning) .

The solution I am thinking of for you is quite easy, but needs a bit of typing in of a lot of text.
So I will do the solution to work on just the first 3 rows using the first 5 rows of data in the Reference Chart. See if you can modify the macro to work for all the rows and data. If you have difficulties, let me know, and then I can complete it all for you in a day or so.

It is also a bit easier to explain the solution for others in the forum if I use a smaller data set.

So my solution, which I will give in the next post will solve this problem, which is your problem shortened.

_____ Workbook: Autofill.xlsx ( Using Excel 2007 32 bit )
Row\Col
B
C
D
E
F
G

2
S. No.
Alpha Code
Sex
Category
Area



3
1







4
2







5
3





Worksheet: Sheet1
Case1
If I paste or enter A in cell C3, then, automatically put the value…
BOY in cell D3, GEN in cell E3 and URBAN in cell F3, as per the REFERENCE CHART
Similarly,
If I paste or enter B in cell C3, then, automatically put the value…
BOY in cell D3, OBC in cell E3 and URBAN in cell F3
Similarly, as shown in REFERENCE CHART, the corresponding value should be filled in the corresponding cells automatically
Now, similarly, same condition is applied to cell C4, C5, ….. that is, If I paste or enter A in cell C4, then, automatically put the value…
BOY in cell D4, GEN in cell E4 and URBAN in cell F4

_____ Workbook: Autofill.xlsx ( Using Excel 2007 32 bit )
Row\Col
R
S
T
U
V
W

1
REFERENCE CHART







2
S. No.
Alpha Code
Sex
Category
Area



3
1
A
BOY
GEN
URBAN



4
2
B
BOY
OBC
URBAN



5
3
C
BOY
SC
URBAN



6
4
D
BOY
ST
URBAN



7
5
E
GIRL
GEN
URBAN

Worksheet: Sheet1

Case2
If I paste or enter BOY in cell D3, GEN in cell E3 and URBAN in cell F3
then, automatically put the value A in cell C3
Similarly,
If I paste or enter BOY in cell D3, OBC in cell E3 and URBAN in cell F3
then, automatically put the value B in cell C3

[DocAElstein]

I think this macro does what you want. I have not checked it thoroughly. I leave it to you to check thoroughly that it does all what you want.
If you have difficulty modifying it for your full range, then let me know and I will do it for you in a few days.



Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Bed
If Application.Intersect(Target, Me.Range("C3:F5")) Is Nothing Then Exit Sub ' No overlap with the entry range, so exit sub
' Case1
If Not Application.Intersect(Target, Me.Range("C3:C5")) Is Nothing Then ' Column C entry
If IsArray(Target.Value) Then Exit Sub ' more than one cell selected, but this procedute can only work on single cell entzries in column C
If Len(Target.Value) <> 1 Then Exit Sub
If InStr(1, ",A,B,C,D,E,", "," & Target.Value & ",", vbBinaryCompare) = 0 Then Exit Sub
Dim PosS As Long: Let PosS = (InStr(1, ",A,B,C,D,E,", Target.Value, vbBinaryCompare) / 2) + 2 ' Row number in REFERENCE CHART for the corrsponding Sex Category Area values
Let Application.EnableEvents = False ' This is to prevent the worksheet change in the next code line setting off this procedure again
Let Target.Offset(0, 1).Resize(1, 3).Value = Me.Range("T" & PosS & ":V" & PosS & "").Value
Let Application.EnableEvents = True
' Case2
ElseIf Not Application.Intersect(Target, Me.Range("D3:F5")) Is Nothing Then ' Entry in column D E or F
If Target.Rows.Count <> 1 Then Exit Sub ' more than 1 row selected, but this procedure can only work on single row entries
Dim arrSCA() As Variant: Let arrSCA() = Array("BOYGENURBAN", "BOYOBCURBAN", "BOYSCURBAN", "BOYSTURBAN", "GIRLGENURBAN")
Dim TrgtRw As Long: Let TrgtRw = Target.Row
Dim DEF As String: Let DEF = Me.Range("D" & TrgtRw).Value & Me.Range("E" & TrgtRw).Value & Me.Range("F" & TrgtRw).Value
Dim Mtchres As Variant
Let Mtchres = Application.Match(DEF, arrSCA(), 0)
If IsError(Mtchres) Then Exit Sub ' no matching set of entries in columns D E and F
Dim PosS2 As Long: Let PosS2 = Mtchres + 2 ' Row number in REFERENCE CHART for the corresponding Alpha Code
Let Application.EnableEvents = False
Let Me.Range("C" & TrgtRw & "").Value = Me.Range("S" & PosS2 & "").Value
Let Application.EnableEvents = True
Else
End If

Bed: ' just incase anything goes wrong, it is a good idea to make sure that things are turned back to normal
Let Application.EnableEvents = True
End Sub





I tried a few values and got these sorts of results

_____ Workbook: Autofill.xlsm ( Using Excel 2007 32 bit )
Row\Col
B
C
D
E
F
G
H

2
S. No.
Alpha Code
Sex
Category
Area



3
1
E
GIRL
GEN
URBAN

7


4
2
D
BOY
ST
URBAN



5
3
B
BOY
OBC
URBAN



6
4





Worksheet: Sheet1


Autofile.xlsm:
https://app.box.com/s/mt1c2xvdejjj6d3vjo6wkjyrdxrs98tm

[Anshu]

A lot of thanks for this help Sir!

I have 4 issues...

1. The Table should NOT be dependent on the References Chart, that is, if I delete the Reference Chart completely, still the code should work. (Actually, It does not work when I delete the Reference Chart).

2. If I delete the Alpha Code from a cell (for example C3), the corresponding range (D3:F3) should be empty/deleted automatically.

3. (Similar to point 2 but in reverse order) If I delete any one cell value from the range (for example D3:F3), the corresponding Alpha Code (C3) should be deleted automatically. It means, the Alpha Code should be appear only if all the three cells in the corresponding range (for example D3:F3) are filled. Otherwise, the Alpha Code should be disappear/deleted.

4. If I enter "a" instead of "A" in the Alpha Code, the code should still work. (Actually, it does not work with small letters, only work with caps lock on)

[DocAElstein]

Hi
_ 4.
This is easy, simply convert the Target.Value to UCase(Target.Value) , and use that converted character in place of Target.Value
( If the Target.Value is already uppercase, then UCase(Target.Value) will not error - Target.Value will just stay as it is )


_ 2. And 3.
This is not difficult, but need s some juggling around with code lines
Two similar code sections are needed

_1. This is a bit more difficult. It is rather unusual not to have a range of the required LookUp information somewhere
This information must come from somewhere.
The most simple solution would be to have that range somewhere
For now , I have put the information on a second worksheet. And made a minor change to the macro to reference that worksheet
If this is not acceptable, then I can put the information somewhere else, such as in the macro itself.



So here is my next solution for you.
Once again for now, for clarity and simplicity, I have limited it just to a few rows


Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Bed
If Application.Intersect(Target, Me.Range("C3:F5")) Is Nothing Then Exit Sub ' No overlap with the entry range, so exit sub
' Case1
If Not Application.Intersect(Target, Me.Range("C3:C5")) Is Nothing Then ' Column C entry
If IsArray(Target.Value) Then Exit Sub ' more than one cell selected, but this procedure can only work on single cell entries in column C
If Target.Value = "" Then 'This would be a cleared cell ( deleted value )
Let Application.EnableEvents = False ' This is to prevent the worksheet change in the next code line setting off this procedure again
Let Target.Offset(0, 1).Resize(1, 3).Value = "" ' If I delete the Alpha Code from a cell (for example C3), the corresponding range (D3:F3) should be empty/deleted automatically.
Let Application.EnableEvents = True
ElseIf Len(Target.Value) <> 1 Then Exit Sub ' we have an entry , but it is invalid
Else
End If
Dim UcsTgtVl As String: Let UcsTgtVl = UCase(Target.Value)
If InStr(1, ",A,B,C,D,E,", "," & UcsTgtVl & ",", vbBinaryCompare) = 0 Then Exit Sub
Dim PosS As Long: Let PosS = (InStr(1, ",A,B,C,D,E,", UcsTgtVl, vbBinaryCompare) / 2) + 2 ' Row number in REFERENCE CHART for the corrsponding Sex Category Area values
Let Application.EnableEvents = False ' This is to prevent the worksheet change in the next code line setting off this procedure again
Let Target.Offset(0, 1).Resize(1, 3).Value = ThisWorkbook.Worksheets("REFERENCE CHART").Range("T" & PosS & ":V" & PosS & "").Value
Let Application.EnableEvents = True
' Case2
ElseIf Not Application.Intersect(Target, Me.Range("D3:F5")) Is Nothing Then ' Entry in column D E or F
If Target.Columns.Count = 1 Then
If Target.Value = "" Then 'This would be a cleared cell ( deleted value )
Let Application.EnableEvents = False ' This is to prevent the worksheet change in the next code line setting off this procedure again
Let Me.Range("C" & Target.Row & "").Value = "" ' If I delete any one cell value from the range (for example D3:F3), the corresponding Alpha Code (C3) should be deleted automatically. It means, the Alpha Code should be appear only if all the three cells in the corresponding range (for example D3:F3) are filled. Otherwise, the Alpha Code should be disappear/deleted.
Let Application.EnableEvents = True
Exit Sub
Else
End If
ElseIf Target.Rows.Count <> 1 Then Exit Sub ' more than 1 row selected, but this procedure can only work on single row entries
Else
End If
Dim arrSCA() As Variant: Let arrSCA() = Array("BOYGENURBAN", "BOYOBCURBAN", "BOYSCURBAN", "BOYSTURBAN", "GIRLGENURBAN")
Dim TrgtRw As Long: Let TrgtRw = Target.Row
Dim DEF As String: Let DEF = Me.Range("D" & TrgtRw).Value & Me.Range("E" & TrgtRw).Value & Me.Range("F" & TrgtRw).Value
Dim Mtchres As Variant
Let Mtchres = Application.Match(DEF, arrSCA, 0)
If IsError(Mtchres) Then Exit Sub ' no matching set of entries in columns D E and F
Dim PosS2 As Long: Let PosS2 = Mtchres + 2 ' Row number in REFERENCE CHART for the corresponding Alpha Code
Let Application.EnableEvents = False
Let Me.Range("C" & TrgtRw & "").Value = Me.Range("S" & PosS2 & "").Value
Let Application.EnableEvents = True
Else
End If

Bed: ' just incase anything goes wrong, it is a good idea to make sure that things are turned back to normal
Let Application.EnableEvents = True
End Sub

Alan



Share ‘Autofill.xlsm’ : https://app.box.com/s/mt1c2xvdejjj6d3vjo6wkjyrdxrs98tm
( Macro copy : https://excelfox.com/forum/showthread.php/2561-Appendix-Thread-(-Codes-for-other-Threads-HTML-Tables-etc-)-Event-Coding?p=14573&viewfull=1#post14573 )

[Anshu]

Thank you for the support! You are really awesome in excel. I don't know how to mark my thread as SOLVED!