Please clarify
Is this what you want ?
string "A1" Drag down = "A2" , "A3", "A4" ...
string "A1" Drag across "B1", "B2", "B3" .... "AA1" .. "ZZ1" ..."AAA1" ...."ZZZ1"
Function Drag(ByVal Previous As Variant) As Variant
Dim t As Long, mySum As Long
Select Case VarType(Previous)
Case 5: Drag = Previous + 1
Case 8: Drag = GetString(UCase(Previous))
End Select
End Function
Private Function GetString(Previous As String) As String
Dim t As Long, pCount As Long, val As Long, myStr As String
Dim AddOne As Boolean
Dim arr() As Variant, arr2 As Variant
pCount = Len(Previous)
AddOne = True
ReDim arr(0 To pCount)
ReDim arr2(0 To pCount)
'convert letters to ascii
For t = pCount To 1 Step -1
arr(pCount - t) = Asc(Mid(Previous, t, 1))
Next t
'add one to value
For t = 0 To UBound(arr) - 1
If AddOne Then val = arr(t) + 1 Else val = arr(t)
AddOne = (val = 91)
If val = 91 Then val = 65
arr2(t) = Chr(val)
Next t
'string values together
For t = pCount To 0 Step -1
myStr = myStr & arr2(t)
Next t
If Len(Replace(myStr, "A", "")) = 0 Then myStr = "A" & myStr
GetString = myStr
End Function
This is my initial stab at your problem
- it is not very elegant but it appears to do what you requested
- it handles either ALL numbers or ALL alpha but alphanumeric not considered
- when I get some time I will look at it again (probably next week)
- in the meantime, please test it and see if it does broadly what you want and let me know
Test it like this
Place the code in a module
In cell B2 enter value AA
In cell C2 enter formula =DRAG(B2) and then drag the formula across
In cell B3 enter formula =DRAG(B2) and then drag the formula down
amend the value in B2 to ZZZ
amend the value in B2 to 120
VBA Code:Function Drag(ByVal Previous As Variant) As Variant Dim t As Long, mySum As Long Select Case VarType(Previous) Case 5: Drag = Previous + 1 Case 8: Drag = GetString(UCase(Previous)) End Select End Function Private Function GetString(Previous As String) As String Dim t As Long, pCount As Long, val As Long, myStr As String Dim AddOne As Boolean Dim arr() As Variant, arr2 As Variant pCount = Len(Previous) AddOne = True ReDim arr(0 To pCount) ReDim arr2(0 To pCount) 'convert letters to ascii For t = pCount To 1 Step -1 arr(pCount - t) = Asc(Mid(Previous, t, 1)) Next t 'add one to value For t = 0 To UBound(arr) - 1 If AddOne Then val = arr(t) + 1 Else val = arr(t) AddOne = (val = 91) If val = 91 Then val = 65 arr2(t) = Chr(val) Next t 'string values together For t = pCount To 0 Step -1 myStr = myStr & arr2(t) Next t If Len(Replace(myStr, "A", "")) = 0 Then myStr = "A" & myStr GetString = myStr End Function
Sub DragFormula()
Dim c As Range, f As Range
Set c = Application.InputBox("Select base cell and click OK", "", , , , , , 8)
Set f = Application.InputBox("Select 1st cell and click OK", "", , , , , , 8)
f.Formula = "=Drag(" & c.Address(0, 0) & ")"
End Sub
sorry, but i am lost, how this supposed to work? ......it is a separate code or suppose to work with the otherHow about a simple procedure, triggered by a shortcut ...asking you to ..
... click on base cell
(which would auto-create the formula =DRAG(BaseCellAddress)
... click on first cell
(which would place the formula in that cell)
VBA Code:Sub DragFormula() Dim c As Range, f As Range Set c = Application.InputBox("Select base cell and click OK", "", , , , , , 8) Set f = Application.InputBox("Select 1st cell and click OK", "", , , , , , 8) f.Formula = "=Drag(" & c.Address(0, 0) & ")" End Sub
Then drag down or across as required