I want a code to hide every two columns with an interval of 1 column. Can anyone help with a VBA script. Eg. Col C&D, F&G, I&J needs to be hidden.
The range is dynamic and subject to change with increase in records.
You can try this:
Dim i As Integer
For i = 1 To Selection.Columns.Count Step 3
Selection.Columns(i + 1).Hidden = True
Selection.Columns(i + 2).Hidden = True
Next i
Should work with any selection.
Dim st As Long, sp As Long
st = Selection.Column
sp = Selection.End(xlToRight).Column
Dim i As Integer
For i = st To sp Step 3
Cells.Columns(i + 1).Hidden = True
Cells.Columns(i + 2).Hidden = True
Next i
Will hide 2 columns every 3 starting from the current cell up to the last column used in the row of the selected cell.
Related
I have been trying out something, by looking at other code ecample and stuff like that.
But I have some problems.
In my data input sheet, i have a dropdown menu with possible Names. But from what I have made now in the code, it just delete that. It does not copy the data over in other sheet and then just blank it out in data sheet, so every time I would have to make the dropdown list again.
Also when it move it over, it first move it to row 2, then to row 4. So jump over row 3, but then after that it just go to row 4 again and overwrite what is in row 4.
I think I need some kind of variables here for each sheet, but Im not strong in VBA, so not sure how to do it.
Here is the code that I have.
Sub CommandButton1_Click()
Dim TargetCounters(3) As Integer
Dim TargetNames(3) As String
TargetNames(0) = "Co"
TargetNames(1) = "Od"
TargetNames(2) = "Th"
TargetNames(3) = "Ca"
Dim i As Integer
Dim shSource As Worksheet
Dim shTargets(3) As Worksheet
Set shSource = ThisWorkbook.Sheets("Data input")
For i = 0 To 3
Set shTargets(i) = ThisWorkbook.Sheets(TargetNames(i))
If shTargets(i).Cells(2, 1).Value = "" Then
TargetCounters(i) = 2
Else
TargetCounters(i) = shTargets(i).Cells(2, 1).CurrentRegion.Rows.Count + 2
End If
Next i
i = 2
Dim MatchIndex As Integer
Do Until shSource.Cells(i, 1).Value = ""
Select Case shSource.Cells(i, 1).Value
Case "Co":
MatchIndex = 0
Case "Od":
MatchIndex = 1
Case "Th":
MatchIndex = 2
Case "Ca":
MatchIndex = 3
Case Else
MatchIndex = -1
End Select
If (MatchIndex = -1) Then
i = i + 1
Else
shSource.Rows(i).Copy
shTargets(MatchIndex).Cells(TargetCounters(MatchIndex), 1).PasteSpecial Paste:=xlPasteValues
shSource.Rows(i).Delete
TargetCounters(MatchIndex) = TargetCounters(MatchIndex) + 1
End If
Loop
End Sub
Here is a link to the excel I made. Right now I only made it to move to 4 sheets, but when working I will be able to add the rest.
https://www.dropbox.com/s/vvjt8z82xiuw9y1/Movedata.xlsm?dl=0
In short my problems is
It delete my dropdown list and it does not insert in a new free row everytime.
EDIT:
Have found out about the delete part now. Found there was function ClearContents instead of Delete.
I have more than 20 hidden columns with data. I want 4 columns to appear and then the next 4 columns on each click of a button.
I tried the below code. Instead of 4 columns at a time, it shows all 20 columns in a click.
Sub compare() '
'compare macro
'selects the button1 rows for the output tab
application.screenupdating=true
range("I10:AR62").entirecolumn/hidden=false
range("B1").select
application.screenupdating=false
End
you want something like:
range(columns(j),columns(j+k)).entirecolumn.hidden=true
range(columns(y),columns(y+z)).entirecolumn.hidden=false
but you need logic to determine what j is... first scenario is where nothing is hidden:
if not columns(9).entirecolumn.hidden and not columns(13).entirecolumn.hidden and not columns(17).entirecolumn.hidden and not columns(21).entirecolumn.hidden then
Then you will want to hide such that:
j = 13
k = 15
Where that scenario is not true (ELSE), you should have some logic embedded to determine what is hidden and unhide other sections:
if not columns(9).entirecolumn.hidden then
j = 9
k = 3
y = 13
z = 3
You would need the above for each of your column groupings to tell what isn't hidden, so you know what grouping is next.
You would have listed what sections will be visible and which sections would be hidden based on the column numbers.
I know it has been a few days since anyone has posted on this, but I figured I would post this part of a macro that I have built for another project. This should work as intended, and the variables are already setup according to the OP's question.
Sub DynHideColumns()
FirstColumn = 9 ' First Column that could be hidden
LastColumn = 200 ' Last Column that could be hidden
ColumnSteps = 4 ' Number of columns to hide per start
x = FirstColumn
Z = 1
ReDim y(1 To ColumnSteps)
Do Until x > LastColumn
If ActiveSheet.Range(Columns(x), Columns(x)).EntireColumn.Hidden = False Then
If Z <= ColumnSteps Then
y(Z) = x
Z = Z + 1
Else
y(1) = ""
End If
End If
x = x + 1
Loop
ActiveSheet.Range(Columns(FirstColumn), Columns(LastColumn)).EntireColumn.Hidden = True
If y(1) = "" Then
ActiveSheet.Range(Columns(FirstColumn), Columns(FirstColumn + ColumnSteps - 1)).EntireColumn.Hidden = False
Else
If y(ColumnSteps) = LastColumn Then
ActiveSheet.Range(Columns(FirstColumn), Columns(FirstColumn + ColumnSteps)).EntireColumn.Hidden = False
Else
ActiveSheet.Range(Columns(y(1) + ColumnSteps), Columns(y(ColumnSteps) + ColumnSteps)).EntireColumn.Hidden = False
End If
End If
End Sub
I have an input sheet called "Testfall-Input-Vorschlag where we have to choose a value from a dropdown in the cells of the first row from the 7th (J)column and when a value gets chosen for example "ARB13" I want to fill out the column where it is selected. The filling of the column is with random values. There is a Sheet called "Admin" which has values stored in the cells of columns from A:ZZ. Now I in the "Testfall-Input-Vorschlag" sheet I want to fill out the cells of the column sequentially. Which means for example for cell(11,7) i want to generate a random value from column A in "Admin" for cell (12,7) the value has to be from Column B in "Admin" for cell (13,7) the value is from column C in "Admin and so on. So I have been trying and I've come up with this code
Sub ARB13()
Dim col As Integer
For i = 11 To 382
For j = 7 To 1000
If Sheets("Testfall-Input_Vorschlag").Cells(1, j) = "ARB13" Then
col = 0
col = col + 1
LB = 2
UB = Sheets("Admin").Range("col" & Rows.Count).End(xlUp).Row
Cells(i, j).Select
ActiveCell.FormulaR1C1 = Sheets("Admin").Range("Y" & Int((UB - LB + 1) * Rnd + LB))
End If
Next j
Next i
End Sub
How can I update the col value for every i. Which means for every i I need col value to be increased by 1. Where am I going wrong?
Define col before you start your first loop, and don't put col = col + 1 in the For j = 7 to 1000 loop. Otherwise col will increment for every j instead of every i. Something like this:
Sub ARB13()
Dim col as Long
Dim i as Long
Dim j as Long
col = 0
For i = 11 To 382
For j = 7 to 1000
LB = 2
UB = Sheets("Admin").Cells(Rows.count, col).End(xlUp).row
Cells(i, j).Select
ActiveCell.FormulaR1C1 = Sheets("Admin").Range("Y" & Int((UB - LB + 1) * Rnd + LB))
Next j
col = col +1
Next i
End Sub
I am trying to do the following: I want to store different areas (marked in yellow) in a string. The first yellow area is F7:G8, second is I7:J8 and so on, such that the string becomes: "F7:G8,I7:J8,L7:M8,F10:G11,I10:J11, L10:M11".
So in this example I have three areas to the right, and two down. The number of areas to the right and downwards may vary, therefore I want to make a code where I only have to specify how many areas to the right and downwards. Note that the first area always is F7:G8, so this I can use as a reference. Now, how many columns one skips before next area might vary, and also how many rows one skips before next area might vary. So this I need to take into account.
I have the following VBA code:
Sub test()
'
' test Makro
'
'
Dim i As Integer, j As Integer
k = 2 'areas downwards'
l = 3 'areas rightwards'
Dim area As String
Let area = "F7:G8" 'first area, always the same'
Dim Upper_letter As String
Let Upper_letter = "F"
Dim Upper_nr As String
Let Upper_nr = "7"
Dim Lower_letter As String
Let Lower_letter = "G"
Dim Lower_nr As String
Let Lower_nr = "8"
For i = 1 To k
For j = 1 To l
area = area & "," & Upper_letter & Upper_nr ":" & Lower_letter & Lower_number
'How do I add 3 letters to both Upper_letter and Lower_letter after each iteration of j?'
Next j
upper_nr = upper_nr + 3 'after each iteration of i, add 3'
lower_nr = lower_nr + 3 'after each iteration of i, add 3'
Next i
End Sub
So I fail to see how I can add letters, in the innermost loop.
Please try this:
Sub ErosRam()
Dim i&, j&, area$, k As Range, r As Range
Const COL_PERIOD = 3
Const ROW_PERIOD = 3
Const REPS_HORIZONTAL = 3
Const REPS_VERTICAL = 2
Set r = [f7:g8]
Set k = r
For i = 0 To REPS_VERTICAL - 1
For j = 0 To REPS_HORIZONTAL - 1
Set k = Union(k, r.Offset(i * ROW_PERIOD, j * COL_PERIOD))
Next
Next
area = k.Address(0, 0)
MsgBox area
End Sub
You can edit the Const lines at the top to change the period and the number of repetitions.
I'm trying to generate words in Column B from a list of given words in Column A.
Right now my code in Excel VBA does this:
Function GetText()
Dim GivenWords
GivenWords = Sheets(1).Range(Sheets(1).[a1], Sheets(1).[a20])
GetText = A(Application.RandBetween(1, UBound(A)), 1)
End Function
This generates a word from the list I have provided in A1:A20, but I don't want any duplicates.
GetText() will be run 15 times in Column B from B1:B15.
How can I check for any duplicates in Column B, or more efficiently, remove the words temporarily from the list once it has been used?
For example,
Select Range A1:A20
Select one value randomly (e.g A5)
A5 is in Column B1
Select Range A1:A4 and A6:A20
Select one value randomly (e.g A7)
A7 is in Column B2
Repeat, etc.
This was trickier than I thought. The formula should be used as a vertical array eg. select the cells where you want the output, press f2 type =gettext(A1:A20) and press ctrl+shift+enter
This means that you can select where your input words are in the worksheet, and the output can be upto as long as that list of inputs, at which point you'll start getting #N/A errors.
Function GetText(GivenWords as range)
Dim item As Variant
Dim list As New Collection
Dim Aoutput() As Variant
Dim tempIndex As Integer
Dim x As Integer
ReDim Aoutput(GivenWords.Count - 1) As Variant
For Each item In GivenWords
list.Add (item.Value)
Next
For x = 0 To GivenWords.Count - 1
tempIndex = Int(Rnd() * list.Count + 1)
Aoutput(x) = list(tempIndex)
list.Remove tempIndex
Next
GetText = Application.WorksheetFunction.Transpose(Aoutput())
End Function
Here's how I would do it, using 2 extra columns, and no VBA code...
A B C D
List of words Rand Rank 15 Words
Apple =RAND() =RANK(B2,$B$2:$B$21) =INDEX($A$2:$A$21,MATCH(ROW()-1,$C$2:$C$21,0))
copy B2 and C2 down as far as the list, and drag D down for however many words you want.
Copy the word list somewhere, as every time you change something on the sheet (or recalculate), you will get a new list of words
Using VBA:
Sub GetWords()
Dim Words
Dim Used(20) As Boolean
Dim NumChosen As Integer
Dim RandWord As Integer
Words = [A1:A20]
NumChosen = 0
While NumChosen < 15
RandWord = Int(Rnd * 20) + 1
If Not Used(RandWord) Then
NumChosen = NumChosen + 1
Used(RandWord) = True
Cells(NumChosen, 2) = Words(RandWord, 1)
End If
Wend
End Sub
Here is the code. I am deleting the cell after using it. Please make a backup of your data before using this as it will delete the cell contents (it will not save automatically...but just in case). You need to run the 'main' sub to get the output.
Sub main()
Dim i As Integer
'as you have put 15 in your question, i am using 15 here. Change it as per your need.
For i = 15 To 1 Step -1
'putting the value of the function in column b (upwards)
Sheets(1).Cells(i, 2).Value = GetText(i)
Next
End Sub
Function GetText(noofrows As Integer)
'if noofrows is 1, the rand function wont work
If noofrows > 1 Then
Dim GivenWords
Dim rowused As Integer
GivenWords = Sheets(1).Range(Sheets(1).Range("A1"), Sheets(1).Range("A" & noofrows))
'getting the randbetween value to a variable bcause after taking the value, we can delete the cell.
rowused = (Application.RandBetween(1, UBound(GivenWords)))
GetText = Sheets(1).Range("A" & rowused)
Application.DisplayAlerts = False
'deleting the cell as we have used it and the function should not use it again
Sheets(1).Cells(rowused, 1).Delete (xlUp)
Application.DisplayAlerts = True
Else
'if noofrows is 1, there is only one value left. so we just use it.
GetText = Sheets(1).Range("A1").Value
Sheets(1).Cells(1, 1).Delete (xlUp)
End If
End Function
Hope this helps.